merge trunkinitsubsystems

1 files changed, 36 insertions, 53 deletions

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 0da5d47..d9dfd37 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -331,13 +331,24 @@ TclSetPreInitScript(
  *----------------------------------------------------------------------
  */
 
+typedef struct PkgName {
+    struct PkgName *nextPtr;	/* Next in list of package names being initialized. */
+    char name[4];
+} PkgName;
+
 int
 Tcl_Init(
     Tcl_Interp *interp)		/* Interpreter to initialize. */
 {
+    PkgName pkgName = {NULL, "Tcl"};
+    PkgName **names = TclInitPkgFiles(interp);
+    int result = TCL_ERROR;
+
+    pkgName.nextPtr = *names;
+    *names = &pkgName;
     if (tclPreInitScript != NULL) {
-	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
-	    return TCL_ERROR;
+	if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
+	    goto end;
 	}
     }
 
@@ -382,7 +393,7 @@ Tcl_Init(
      * alternate tclInit command before calling Tcl_Init().
      */
 
-    return Tcl_Eval(interp,
+    result = Tcl_EvalEx(interp,
 "if {[namespace which -command tclInit] eq \"\"} {\n"
 "  proc tclInit {} {\n"
 "    global tcl_libPath tcl_library env tclDefaultLibrary\n"
@@ -410,6 +421,7 @@ Tcl_Init(
 "	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
 "	{file join $parentDir library} \\\n"
 "	{file join $grandParentDir library} \\\n"
+"	{file join $grandParentDir tcl[info tclversion] library} \\\n"
 "	{file join $grandParentDir tcl[info patchlevel] library} \\\n"
 "	{\n"
 "file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
@@ -444,7 +456,11 @@ Tcl_Init(
 "    error $msg\n"
 "  }\n"
 "}\n"
-"tclInit");
+"tclInit", -1, 0);
+
+end:
+    *names = (*names)->nextPtr;
+    return result;
 }
 
 /*
@@ -660,14 +676,9 @@ NRInterpCmd(
 	    if (masterInterp == NULL) {
 		return TCL_ERROR;
 	    }
-	    if (TclGetString(objv[5])[0] == '\0') {
-		if (objc == 6) {
-		    return AliasDelete(interp, slaveInterp, objv[3]);
-		}
-	    } else {
-		return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
-			objv[5], objc - 6, objv + 6);
-	    }
+
+	    return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
+		    objv[5], objc - 6, objv + 6);
 	}
 	goto aliasArgs;
     }
@@ -723,7 +734,7 @@ NRInterpCmd(
 	}
 
     endOfForLoop:
-	if ((i + 2) < objc) {
+	if (i < objc - 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv,
 		    "?-unwind? ?--? ?path? ?result?");
 	    return TCL_ERROR;
@@ -1795,11 +1806,9 @@ AliasNRCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument vector. */
 {
-    Interp *iPtr = (Interp *) interp;
     Alias *aliasPtr = clientData;
     int prefc, cmdc, i;
     Tcl_Obj **prefv, **cmdv;
-    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
     Tcl_Obj *listPtr;
     List *listRep;
     int flags = TCL_EVAL_INVOKE;
@@ -1831,21 +1840,7 @@ AliasNRCmd(
      * only the source command should show, not the full target prefix.
      */
 
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = objv;
-	iPtr->ensembleRewrite.numRemovedObjs = 1;
-	iPtr->ensembleRewrite.numInsertedObjs = prefc;
-    } else {
-	iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
-    }
-
-    /*
-     * We are sending a 0-refCount obj, do not need a callback: it will be
-     * cleaned up automatically. But we may need to clear the rootEnsemble
-     * stuff ...
-     */
-
-    if (isRootEnsemble) {
+    if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
 	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
     }
     TclSkipTailcall(interp);
@@ -1866,7 +1861,7 @@ AliasObjCmd(
     Tcl_Obj **prefv, **cmdv;
     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
     Interp *tPtr = (Interp *) targetInterp;
-    int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
+    int isRootEnsemble;
 
     /*
      * Append the arguments to the command prefix and invoke the command in
@@ -1882,7 +1877,6 @@ AliasObjCmd(
 	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
     }
 
-    prefv = &aliasPtr->objPtr;
     memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
     memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
 
@@ -1897,13 +1891,7 @@ AliasObjCmd(
      * only the source command should show, not the full target prefix.
      */
 
-    if (isRootEnsemble) {
-	tPtr->ensembleRewrite.sourceObjs = objv;
-	tPtr->ensembleRewrite.numRemovedObjs = 1;
-	tPtr->ensembleRewrite.numInsertedObjs = prefc;
-    } else {
-	tPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
-    }
+    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)tPtr, 1, prefc, objv);
 
     /*
      * Protect the target interpreter if it isn't the same as the source
@@ -1926,9 +1914,7 @@ AliasObjCmd(
      */
 
     if (isRootEnsemble) {
-	tPtr->ensembleRewrite.sourceObjs = NULL;
-	tPtr->ensembleRewrite.numRemovedObjs = 0;
-	tPtr->ensembleRewrite.numInsertedObjs = 0;
+	TclResetRewriteEnsemble((Tcl_Interp *)tPtr, 1);
     }
 
     /*
@@ -2393,7 +2379,7 @@ SlaveCreate(
 	    SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
     Tcl_SetHashValue(hPtr, slavePtr);
-    Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
+    Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
 
     /*
      * Inherit the recursion limit.
@@ -3220,8 +3206,8 @@ Tcl_MakeSafe(
 	 * Assume these functions all work. [Bug 2895741]
 	 */
 
-	(void) Tcl_Eval(interp,
-		"namespace eval ::tcl {namespace eval mathfunc {}}");
+	(void) Tcl_EvalEx(interp,
+		"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
 	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
 		"::tcl::mathfunc::min", 0, NULL);
 	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
@@ -3547,9 +3533,6 @@ Tcl_LimitAddHandler(
     if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
 	deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
     }
-    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) {
-	deleteProc = NULL;
-    }
 
     /*
      * Allocate a handler record.
@@ -4527,7 +4510,7 @@ SlaveCommandLimitCmd(
 	    switch ((enum Options) index) {
 	    case OPT_CMD:
 		scriptObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
+		(void) TclGetStringFromObj(scriptObj, &scriptLen);
 		break;
 	    case OPT_GRAN:
 		granObj = objv[i+1];
@@ -4544,7 +4527,7 @@ SlaveCommandLimitCmd(
 		break;
 	    case OPT_VAL:
 		limitObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
+		(void) TclGetStringFromObj(objv[i+1], &limitLen);
 		if (limitLen == 0) {
 		    break;
 		}
@@ -4736,7 +4719,7 @@ SlaveTimeLimitCmd(
 	    switch ((enum Options) index) {
 	    case OPT_CMD:
 		scriptObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
+		(void) TclGetStringFromObj(objv[i+1], &scriptLen);
 		break;
 	    case OPT_GRAN:
 		granObj = objv[i+1];
@@ -4753,7 +4736,7 @@ SlaveTimeLimitCmd(
 		break;
 	    case OPT_MILLI:
 		milliObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
+		(void) TclGetStringFromObj(objv[i+1], &milliLen);
 		if (milliLen == 0) {
 		    break;
 		}
@@ -4771,7 +4754,7 @@ SlaveTimeLimitCmd(
 		break;
 	    case OPT_SEC:
 		secObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
+		(void) TclGetStringFromObj(objv[i+1], &secLen);
 		if (secLen == 0) {
 		    break;
 		}