merge pyk-listdictstringrep

of a value.

generic/tclBasic.c

@@ -234,7 +234,7 @@ static const CmdInfo builtInCmds[] = {
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
-    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
     {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
     {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
     {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},

generic/tclDictObj.c

@@ -62,6 +62,8 @@ static int		DictWithCmd(ClientData dummy, Tcl_Interp *interp,
 static void		DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static void		FreeDictInternalRep(Tcl_Obj *dictPtr);
 static void		InvalidateDictChain(Tcl_Obj *dictObj);
+static void		InvalidateListRep(Tcl_Obj *dictObj);
+static void		InvalidateOtherReps(Tcl_Obj *dictObj);
 static int		SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
 static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
@@ -426,6 +428,7 @@ FreeDictInternalRep(
     Tcl_Obj *dictPtr)
 {
     Dict *dict = DICT(dictPtr);
+    InvalidateListRep(dictPtr);
 
     dict->refcount--;
     if (dict->refcount <= 0) {
@@ -497,13 +500,24 @@ UpdateStringOfDict(
     const char *elem;
     char *dst;
     const int maxFlags = UINT_MAX / sizeof(int);
+    Tcl_Obj *listObj;
+    int numElems;
+
+    if (dictPtr->internalRep.twoPtrValue.ptr2 != NULL) {
+	listObj = dictPtr->internalRep.twoPtrValue.ptr2;
+	TclGetString(listObj);
+	dictPtr->bytes = listObj->bytes;
+	dictPtr->length = listObj->length;
+	listObj->bytes = NULL;
+	return;
+    }
 
     /*
      * This field is the most useful one in the whole hash structure, and it
      * is not exposed by any API function...
      */
 
-    int numElems = dict->table.numEntries * 2;
+    numElems = dict->table.numEntries * 2;
 
     /* Handle empty list case first, simplifies what follows */
     if (numElems == 0) {
@@ -603,8 +617,9 @@ SetDictFromAny(
     Tcl_Obj *objPtr)
 {
     Tcl_HashEntry *hPtr;
-    int isNew;
+    int isNew, needlist = 0;
     Dict *dict = ckalloc(sizeof(Dict));
+    Tcl_Obj *listObj;
 
     InitChainTable(dict);
 
@@ -614,12 +629,14 @@ SetDictFromAny(
      * the conversion from lists to dictionaries.
      */
 
-    if (objPtr->typePtr == &tclListType) {
+
+    listObj = TclObjLookupTyped(objPtr, &tclListType);
+    if (listObj != NULL) {
 	int objc, i;
 	Tcl_Obj **objv;
 
 	/* Cannot fail, we already know the Tcl_ObjType is "list". */
-	TclListObjGetElements(NULL, objPtr, &objc, &objv);
+	TclListObjGetElements(NULL, listObj, &objc, &objv);
 	if (objc & 1) {
 	    goto missingValue;
 	}
@@ -630,16 +647,8 @@ SetDictFromAny(
 	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
 	    if (!isNew) {
 		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
-
-		/*
-		 * Not really a well-formed dictionary as there are duplicate
-		 * keys, so better get the string rep here so that we can
-		 * convert back.
-		 */
-
-		(void) Tcl_GetString(objPtr);
-
-		TclDecrRefCount(discardedValue);
+		needlist = 1;
+		Tcl_DecrRefCount(discardedValue);
 	    }
 	    Tcl_SetHashValue(hPtr, objv[i+1]);
 	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
@@ -710,12 +719,21 @@ SetDictFromAny(
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-    TclFreeIntRep(objPtr);
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
+    if (needlist) {
+	/* squirrel the list intrep away for use by SetListFromAny  */
+	listObj = Tcl_DuplicateObj(listObj);
+	Tcl_IncrRefCount(listObj);
+    }
+    TclFreeIntRep(objPtr);
+    if (needlist) {
+	objPtr->internalRep.twoPtrValue.ptr2 = listObj;
+    } else {
+	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    }
     DICT(objPtr) = dict;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     objPtr->typePtr = &tclDictType;
     return TCL_OK;
 
@@ -866,7 +884,7 @@ InvalidateDictChain(
     Dict *dict = DICT(dictObj);
 
     do {
-	TclInvalidateStringRep(dictObj);
+	InvalidateOtherReps(dictObj);
 	dict->epoch++;
 	dictObj = dict->chain;
 	if (dictObj == NULL) {
@@ -877,6 +895,25 @@ InvalidateDictChain(
     } while (dict != NULL);
 }
 
+static void InvalidateListRep(
+    Tcl_Obj *dictObj
+) {
+    Tcl_Obj *listObj;
+
+    if (dictObj->internalRep.twoPtrValue.ptr2 != NULL) {
+	listObj = dictObj->internalRep.twoPtrValue.ptr2;
+	Tcl_DecrRefCount(listObj);
+	dictObj->internalRep.twoPtrValue.ptr2 = NULL;
+    }
+}
+
+static void InvalidateOtherReps(
+    Tcl_Obj * dictObj
+) {
+    TclInvalidateStringRep(dictObj);
+    InvalidateListRep(dictObj);
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -917,7 +954,7 @@ Tcl_DictObjPut(
     }
 
     if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
     }
     dict = DICT(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
@@ -1017,7 +1054,7 @@ Tcl_DictObjRemove(
     dict = DICT(dictPtr);
     if (DeleteChainEntry(dict, keyPtr)) {
 	if (dictPtr->bytes != NULL) {
-	    TclInvalidateStringRep(dictPtr);
+	    InvalidateOtherReps(dictPtr);
 	}
 	dict->epoch++;
     }
@@ -1631,7 +1668,7 @@ DictReplaceCmd(
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
     if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
     }
     for (i=2 ; i<objc ; i+=2) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
@@ -1681,9 +1718,7 @@ DictRemoveCmd(
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    InvalidateOtherReps(dictPtr);
     for (i=2 ; i<objc ; i++) {
 	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
     }
@@ -2155,7 +2190,7 @@ DictIncrCmd(
 	}
     }
     if (code == TCL_OK) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
 	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
 		dictPtr, TCL_LEAVE_ERR_MSG);
 	if (valuePtr == NULL) {
@@ -2244,7 +2279,7 @@ DictLappendCmd(
     if (allocatedValue) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
     } else if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
     }
 
     resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,

generic/tclExecute.c

@@ -5437,22 +5437,58 @@ TEBCresume(
 		}
 	    } else {
 		/*
-		 * strcmp can't do a simple memcmp in order to handle the
-		 * special Tcl \xC0\x80 null encoding for utf-8.
+		 * In order to handle the special Tcl \xC0\x80 null encoding
+		 * for utf-8, strcmp can't do a simple memcmp.
 		 */
 
-		s1 = TclGetStringFromObj(valuePtr, &s1len);
-		s2 = TclGetStringFromObj(value2Ptr, &s2len);
+		if (TclCheckEmptyString(valuePtr) > 0) {
+		    s1 = "";
+		    s1len = 0;
+		    switch (TclCheckEmptyString(value2Ptr)) {
+			case -1:
+			    s2 = TclGetStringFromObj(value2Ptr, &s2len);
+			    break;
+			case 0:
+			    /* Synthesize a value for comparison */
+			    s2 = "1";
+			    s2len = 1;
+			    break;
+			case 1:
+			    s2 = "";
+			    s2len = 0;
+		    }
+		} else if (TclCheckEmptyString(value2Ptr) > 0) {
+		    s2 = "";
+		    s2len = 0;
+		    switch (TclCheckEmptyString(valuePtr)) {
+			case -1:
+			    s1 = TclGetStringFromObj(valuePtr, &s1len);
+			    break;
+			case 0:
+			    /* Synthesize a value for comparison */
+			    s1 = "1";
+			    s1len = 1;
+			    break;
+			case 1:
+			    s1 = "";
+			    s1len = 0;
+		    }
+		} else {
+		    s1 = TclGetStringFromObj(valuePtr, &s1len);
+		    s2 = TclGetStringFromObj(value2Ptr, &s2len);
+		}
+
 		if (checkEq) {
 		    memCmpFn = memcmp;
 		} else {
 		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
 		}
+
 	    }
 
 	    if (checkEq && (s1len != s2len)) {
 		match = 1;
-	    } else {
+	    }  else {
 		/*
 		 * The comparison function should compare up to the minimum
 		 * byte length only.
@@ -6163,6 +6199,14 @@ TEBCresume(
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
 
+	/*
+	    Try to determine, without triggering generation of a string
+	    representation, whether one value is not a number.
+	*/
+	if (TclCheckEmptyString(valuePtr) > 1 || TclCheckEmptyString(value2Ptr) > 1) {
+	    goto stringCompare;
+	}
+
 	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
 	    /*
 	     * At least one non-numeric argument - compare as strings.

generic/tclInt.h

@@ -883,6 +883,7 @@ typedef struct VarInHash {
     (TclIsVarDirectModifyable(varPtr) &&\
 	(!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE))))
 
+
 /*
  *----------------------------------------------------------------
  * Data structures related to procedures. These are used primarily in
@@ -2424,6 +2425,7 @@ typedef struct List {
 #define TclListObjIsCanonical(listPtr) \
     (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)
 
+
 /*
  * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
  * TclNRLmapCmd and their compilations.
@@ -2510,6 +2512,28 @@ typedef struct List {
 
 #define DICT_PATH_NON_EXISTENT	((Tcl_Obj *) (void *) 1)
 
+/* 
+ * Macros for tclStringType objects
+ */
+
+#define TclStringGetPrev(objPtr)					    \
+    ((Tcl_Obj *)((objPtr)->internalRep.twoPtrValue.ptr2))
+#define TclStringSetPrev(objPtr,prevPtr)				    \
+    do {								    \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (prevPtr);   \
+    } while (0)
+#define TclStringInvalidatePrev(objPtr)				    \
+    do {								    \
+	if (TclStringGetPrev((objPtr)) != NULL) {			    \
+	    Tcl_DecrRefCount(TclStringGetPrev((objPtr)));		    \
+	}								    \
+	(objPtr)->internalRep.twoPtrValue.ptr2 = NULL;		    \
+    } while (0)
+
+#define TclStringPrevIs(objPtr, checkTypePtr) \
+    (TclStringGetPrev((objPtr))->typePtr == &(checkTypePtr))
+
+
 /*
  *----------------------------------------------------------------
  * Data structures related to the filesystem internals
@@ -2746,6 +2770,10 @@ MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
 MODULE_SCOPE char *	tclEmptyStringRep;
 MODULE_SCOPE char	tclEmptyString;
 
+enum CheckEmptyStringResult {
+	TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
+};
+
 /*
  *----------------------------------------------------------------
  * Procedures shared among Tcl modules but not used by the outside world,
@@ -2761,6 +2789,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
@@ -3037,6 +3066,7 @@ MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[],
 			    Tcl_Namespace *nsPtr, int flags);
+MODULE_SCOPE Tcl_Obj *	TclObjLookupTyped (Tcl_Obj * objPtr, Tcl_ObjType *typeptr);
 MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
 			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
 MODULE_SCOPE int	TclParseBackslash(const char *src,
@@ -3934,6 +3964,7 @@ MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
 
 /*
  * Functions defined in generic/tclVar.c and currenttly exported only for use
@@ -4419,6 +4450,12 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 #define TclIsPureByteArray(objPtr) \
 	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
 
+#define TclIsPureDict(objPtr) \
+	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
+
+#define TclIsPureList(objPtr) \
+	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
+
 /*
  *----------------------------------------------------------------
  * Macro used by the Tcl core to compare Unicode strings. On big-endian

generic/tclListObj.c

@@ -13,6 +13,7 @@
 
 #include "tclInt.h"
 
+#define LIST(listObj)    ((List *)(listObj)->internalRep.twoPtrValue.ptr1)
 /*
  * Prototypes for functions defined later in this file:
  */
@@ -20,8 +21,8 @@
 static List *		AttemptNewList(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 static List *		NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
-static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static void		FreeListInternalRep(Tcl_Obj *listPtr);
+static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfList(Tcl_Obj *listPtr);
 
@@ -1822,18 +1823,28 @@ SetListFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
     Tcl_Obj *objPtr)		/* The object to convert. */
 {
+    Tcl_Obj *listPtr;
     List *listRepPtr;
     Tcl_Obj **elemPtrs;
 
     /*
-     * Dictionaries are a special case; they have a string representation such
-     * that *all* valid dictionaries are valid lists. Hence we can convert
-     * more directly. Only do this when there's no existing string rep; if
-     * there is, it is the string rep that's authoritative (because it could
-     * describe duplicate keys).
+     * Dictionaries are a special case; they may have stored a previous list
+     * representation
      */
 
-    if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+     listPtr = TclObjLookupTyped(objPtr, &tclListType);
+     if (listPtr != NULL) {
+	Tcl_IncrRefCount(listPtr);
+	TclFreeIntRep(objPtr);
+	DupListInternalRep(listPtr, objPtr); 
+	Tcl_DecrRefCount(listPtr);
+	objPtr->typePtr = &tclListType;
+	/* To Do: Maybe keep the dict intrep around in case this object is
+	 * used as a dict again */
+	return TCL_OK;
+     }
+
+    if (objPtr->typePtr == &tclDictType) {
 	Tcl_Obj *keyPtr, *valuePtr;
 	Tcl_DictSearch search;
 	int done, size;

generic/tclObj.c

@@ -4491,6 +4491,46 @@ Tcl_RepresentationCmd(
     return TCL_OK;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupObjTyped  --
+ *
+ *	Given a Tcl_Obj, find an corresponding object, if one exists, of a
+ *	given type.
+ *
+ * Results:
+ *	The found object, or, if no such corresponding object was found, NULL.
+ *	
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclObjLookupTyped (Tcl_Obj * objPtr, Tcl_ObjType *typePtr) {
+    Tcl_Obj *foundPtr;
+    if (typePtr == objPtr->typePtr) {
+	return objPtr;
+    }
+    if (objPtr->typePtr == &tclStringType) {
+	foundPtr = TclStringGetPrev(objPtr);
+	if (foundPtr == NULL) {
+	    return NULL;
+	}
+	return TclObjLookupTyped(foundPtr, typePtr);
+    }
+    if (typePtr == &tclListType) {
+	if (objPtr->typePtr == &tclDictType && objPtr->internalRep.twoPtrValue.ptr2 != NULL) {
+	    /* A usable list representation exists.  */
+	    return objPtr->internalRep.twoPtrValue.ptr2;
+	}
+    }
+    return NULL;
+}
+
 /*
  * Local Variables:
  * mode: c

generic/tclPkg.c

@@ -49,6 +49,29 @@ typedef struct Package {
     const void *clientData;	/* Client data. */
 } Package;
 
+
+/* PkgRequireState is passed between functions that form a unit of execution but that
+*  are chunked up for the NRE *
+*/
+typedef struct PkgRequireState {
+    const char *name;
+    int reqc;
+    int pass;
+    int code;
+    Package *pkgPtr;
+    PkgAvail *availPtr;
+    PkgAvail *bestPtr;
+    PkgAvail *bestStablePtr;
+    char *bestVersion; /* Internal rep. of versions */
+    char *availVersion;
+    int availStable;
+    char *pkgVersionI;
+    void *clientDataPtr;
+    char *result;
+    char *versionToProvide;
+    Tcl_Obj *scriptObj;
+} PkgRequireState;
+
 /*
  * Prototypes for functions defined in this file:
  */
@@ -69,10 +92,24 @@ static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
 static void		AddRequirementsToDString(Tcl_DString *dstring,
 			    int reqc, Tcl_Obj *const reqv[]);
 static Package *	FindPackage(Tcl_Interp *interp, const char *name);
-static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
-			    int reqc, Tcl_Obj *const reqv[],
-			    void *clientDataPtr);
 
+/* 
+    This sequence is listed in order of execution.  Later in the code they
+    don't appear in order of execution because they are pushed onto the
+    callback stack in reverse order of execution, and dynamically as processing
+    of the callback stack proceeds.
+*/
+int			TclNRPkgRequireProc(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreUnknown(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreUnknownEvalFinish(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreUnknownFinish(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreBest(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreBestEvalFinish(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreBestFinish(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreCheckFound(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireCoreFinish(ClientData data[], Tcl_Interp *interp, int result);
+int			PkgRequireProcFinish(ClientData data[], Tcl_Interp *interp, int result);
 /*
  * Helper macros.
  */
@@ -299,18 +336,22 @@ Tcl_PkgRequireEx(
      */
 
     if (version == NULL) {
-	result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
+	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
+	    result = Tcl_GetStringResult(interp);
+	}
     } else {
 	if (exact && TCL_OK
 		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
 	    return NULL;
 	}
 	ov = Tcl_NewStringObj(version, -1);
+	Tcl_IncrRefCount(ov);
 	if (exact) {
 	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
 	}
-	Tcl_IncrRefCount(ov);
-	result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
+	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
+	    result = Tcl_GetStringResult(interp);
+	}
 	TclDecrRefCount(ov);
     }
 
@@ -328,39 +369,65 @@ Tcl_PkgRequireProc(
 				 * available. */
     void *clientDataPtr)
 {
-    const char *result =
-	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
+    NRE_callback *rootPtr = TOP_CB(interp);
+    TclNRAddCallback(
+	interp, TclNRPkgRequireProc, name, INT2PTR(reqc), reqv, clientDataPtr);
+    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+}
 
-    if (result == NULL) {
+int
+TclNRPkgRequireProc(
+    ClientData data[],
+    Tcl_Interp *interp,		/* Interpreter in which package is now
+				 * available. */
+    int result
+
+) {
+    PkgRequireState *statePtr;
+    statePtr = ckalloc(sizeof(PkgRequireState));
+    statePtr->code = TCL_OK;
+    statePtr->name = data[0];
+    statePtr->reqc = PTR2INT(data[1]);
+    statePtr->pass = 1;
+    statePtr->clientDataPtr = data[3];
+    statePtr->result = NULL;
+
+    if (TCL_OK != CheckAllRequirements(interp, statePtr->reqc, data[2])) {
 	return TCL_ERROR;
     }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
+
+    Tcl_NRAddCallback(interp, PkgRequireCore, statePtr, data[2], NULL, NULL);
     return TCL_OK;
 }
 
-static const char *
-PkgRequireCore(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
-				 * available. */
-    const char *name,		/* Name of desired package. */
-    int reqc,			/* Requirements constraining the desired
-				 * version. */
-    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
-				 * available. */
-    void *clientDataPtr)
-{
-    Interp *iPtr = (Interp *) interp;
-    Package *pkgPtr;
-    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
-    char *availVersion, *bestVersion;
-				/* Internal rep. of versions */
-    int availStable, code, satisfies, pass;
-    char *script, *pkgVersionI;
-    Tcl_DString command;
-
-    if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
-	return NULL;
+int
+TclPkgRequireProcFinish(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    int objc = PTR2INT(data[0]);
+    Tcl_Obj *const *objv = data[1];
+    while (objc-- > 0) {
+	Tcl_DecrRefCount(objv[objc]);
     }
+    if (data[2] != NULL) {
+	Tcl_DecrRefCount(data[2]);
+    }
+    return result;
+}
+
+int
+PkgRequireCore(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result0
+) {
+    PkgRequireState *statePtr = data[0];
+    Tcl_Obj *const *reqv = data[1];
+
+    Interp *iPtr = (Interp *) interp;
+    int satisfies;
 
     /*
      * It can take up to three passes to find the package: one pass to run the
@@ -369,256 +436,380 @@ PkgRequireCore(
      * the "package ifneeded" script.
      */
 
-    for (pass=1 ;; pass++) {
-	pkgPtr = FindPackage(interp, name);
-	if (pkgPtr->version != NULL) {
-	    break;
+    statePtr->pkgPtr = FindPackage(interp, statePtr->name);
+    if (statePtr->pkgPtr->version != NULL) {
+	Tcl_NRAddCallback(interp, PkgRequireCoreCheckFound,
+	    statePtr, (ClientData)reqv, NULL, NULL);
+	return TCL_OK;
+    }
+
+    /*
+     * Check whether we're already attempting to load some version of this
+     * package (circular dependency detection).
+     */
+
+    if (statePtr->pkgPtr->clientData != NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"circular package dependency:"
+		" attempt to provide %s %s requires %s",
+		statePtr->name, (char *) statePtr->pkgPtr->clientData,
+		statePtr->name));
+	AddRequirementsToResult(interp, statePtr->reqc, reqv);
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
+	TclNRAddCallback(
+	    interp, PkgRequireCoreFinish, statePtr, NULL, NULL, NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * The package isn't yet present. Search the list of available
+     * versions and invoke the script for the best available version. We
+     * are actually locating the best, and the best stable version. One of
+     * them is then chosen based on the selection mode.
+     */
+
+    statePtr->bestPtr = NULL;
+    statePtr->bestStablePtr = NULL;
+    statePtr->bestVersion = NULL;
+
+    for (statePtr->availPtr = statePtr->pkgPtr->availPtr; statePtr->availPtr != NULL;
+	    statePtr->availPtr = statePtr->availPtr->nextPtr) {
+	if (CheckVersionAndConvert(interp, statePtr->availPtr->version,
+		&statePtr->availVersion, &statePtr->availStable) != TCL_OK) {
+	    /*
+	     * The provided version number has invalid syntax. This
+	     * should not happen. This should have been caught by the
+	     * 'package ifneeded' registering the package.
+	     */
+
+	    continue;
 	}
 
-	/*
-	 * Check whether we're already attempting to load some version of this
-	 * package (circular dependency detection).
-	 */
+	if (statePtr->bestPtr != NULL) {
+	    int res = CompareVersions(statePtr->availVersion, statePtr->bestVersion, NULL);
 
-	if (pkgPtr->clientData != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "circular package dependency:"
-		    " attempt to provide %s %s requires %s",
-		    name, (char *) pkgPtr->clientData, name));
-	    AddRequirementsToResult(interp, reqc, reqv);
-	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
-	    return NULL;
-	}
+	    /*
+	     * Note: Use internal reps!
+	     */
 
-	/*
-	 * The package isn't yet present. Search the list of available
-	 * versions and invoke the script for the best available version. We
-	 * are actually locating the best, and the best stable version. One of
-	 * them is then chosen based on the selection mode.
-	 */
-
-	bestPtr = NULL;
-	bestStablePtr = NULL;
-	bestVersion = NULL;
-
-	for (availPtr = pkgPtr->availPtr; availPtr != NULL;
-		availPtr = availPtr->nextPtr) {
-	    if (CheckVersionAndConvert(interp, availPtr->version,
-		    &availVersion, &availStable) != TCL_OK) {
+	    if (res <= 0) {
 		/*
-		 * The provided version number has invalid syntax. This
-		 * should not happen. This should have been caught by the
-		 * 'package ifneeded' registering the package.
+		 * The version of the package sought is not as good as the
+		 * currently selected version. Ignore it.
 		 */
 
+		ckfree(statePtr->availVersion);
+		statePtr->availVersion = NULL;
 		continue;
 	    }
-
-	    if (bestPtr != NULL) {
-		int res = CompareVersions(availVersion, bestVersion, NULL);
-
-		/*
-		 * Note: Use internal reps!
-		 */
-
-		if (res <= 0) {
-		    /*
-		     * The version of the package sought is not as good as the
-		     * currently selected version. Ignore it.
-		     */
-
-		    ckfree(availVersion);
-		    availVersion = NULL;
-		    continue;
-		}
-	    }
-
-	    /*
-	     * We have found a version which is better than our max.
-	     */
-
-	    if (reqc > 0) {
-		/* Check satisfaction of requirements. */
-
-		satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
-		if (!satisfies) {
-		    ckfree(availVersion);
-		    availVersion = NULL;
-		    continue;
-		}
-	    }
-
-	    bestPtr = availPtr;
-
-	    if (bestVersion != NULL) {
-		ckfree(bestVersion);
-	    }
-	    bestVersion = availVersion;
-
-	    /*
-	     * If this new best version is stable then it also has to be
-	     * better than the max stable version found so far.
-	     */
-
-	    if (availStable) {
-		bestStablePtr = availPtr;
-	    }
-	}
-
-	if (bestVersion != NULL) {
-	    ckfree(bestVersion);
 	}
 
 	/*
-	 * Now choose a version among the two best. For 'latest' we simply
-	 * take (actually keep) the best. For 'stable' we take the best
-	 * stable, if there is any, or the best if there is nothing stable.
+	 * We have found a version which is better than our max.
 	 */
 
-	if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
-		&& (bestStablePtr != NULL)) {
-	    bestPtr = bestStablePtr;
+	if (statePtr->reqc > 0) {
+	    /* Check satisfaction of requirements. */
+	    satisfies = SomeRequirementSatisfied(
+		statePtr->availVersion, statePtr->reqc, reqv);
+	    if (!satisfies) {
+		ckfree(statePtr->availVersion);
+		statePtr->availVersion = NULL;
+		continue;
+	    }
 	}
 
-	if (bestPtr != NULL) {
-	    /*
-	     * We found an ifneeded script for the package. Be careful while
-	     * executing it: this could cause reentrancy, so (a) protect the
-	     * script itself from deletion and (b) don't assume that bestPtr
-	     * will still exist when the script completes.
-	     */
+	statePtr->bestPtr = statePtr->availPtr;
 
-	    char *versionToProvide = bestPtr->version;
-	    script = bestPtr->script;
-
-	    pkgPtr->clientData = versionToProvide;
-	    Tcl_Preserve(script);
-	    Tcl_Preserve(versionToProvide);
-	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
-	    Tcl_Release(script);
-
-	    pkgPtr = FindPackage(interp, name);
-	    if (code == TCL_OK) {
-		Tcl_ResetResult(interp);
-		if (pkgPtr->version == NULL) {
-		    code = TCL_ERROR;
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "attempt to provide package %s %s failed:"
-			    " no version of package %s provided",
-			    name, versionToProvide, name));
-		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
-			    NULL);
-		} else {
-		    char *pvi, *vi;
-
-		    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
-			    NULL) != TCL_OK) {
-			code = TCL_ERROR;
-		    } else if (CheckVersionAndConvert(interp,
-			    versionToProvide, &vi, NULL) != TCL_OK) {
-			ckfree(pvi);
-			code = TCL_ERROR;
-		    } else {
-			int res = CompareVersions(pvi, vi, NULL);
-
-			ckfree(pvi);
-			ckfree(vi);
-			if (res != 0) {
-			    code = TCL_ERROR;
-			    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-				    "attempt to provide package %s %s failed:"
-				    " package %s %s provided instead",
-				    name, versionToProvide,
-				    name, pkgPtr->version));
-			    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
-				    "WRONGPROVIDE", NULL);
-			}
-		    }
-		}
-	    } else if (code != TCL_ERROR) {
-		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
-
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"attempt to provide package %s %s failed:"
-			" bad return code: %s",
-			name, versionToProvide, TclGetString(codePtr)));
-		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
-		TclDecrRefCount(codePtr);
-		code = TCL_ERROR;
-	    }
-
-	    if (code == TCL_ERROR) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (\"package ifneeded %s %s\" script)",
-			name, versionToProvide));
-	    }
-	    Tcl_Release(versionToProvide);
-
-	    if (code != TCL_OK) {
-		/*
-		 * Take a non-TCL_OK code from the script as an indication the
-		 * package wasn't loaded properly, so the package system
-		 * should not remember an improper load.
-		 *
-		 * This is consistent with our returning NULL. If we're not
-		 * willing to tell our caller we got a particular version, we
-		 * shouldn't store that version for telling future callers
-		 * either.
-		 */
-
-		if (pkgPtr->version != NULL) {
-		    ckfree(pkgPtr->version);
-		    pkgPtr->version = NULL;
-		}
-		pkgPtr->clientData = NULL;
-		return NULL;
-	    }
-
-	    break;
+	if (statePtr->bestVersion != NULL) {
+	    ckfree(statePtr->bestVersion);
 	}
+	statePtr->bestVersion = statePtr->availVersion;
 
 	/*
-	 * The package is not in the database. If there is a "package unknown"
-	 * command, invoke it (but only on the first pass; after that, we
-	 * should not get here in the first place).
+	 * If this new best version is stable then it also has to be
+	 * better than the max stable version found so far.
 	 */
 
-	if (pass > 1) {
-	    break;
-	}
-
-	script = ((Interp *) interp)->packageUnknown;
-	if (script != NULL) {
-	    Tcl_DStringInit(&command);
-	    Tcl_DStringAppend(&command, script, -1);
-	    Tcl_DStringAppendElement(&command, name);
-	    AddRequirementsToDString(&command, reqc, reqv);
-
-	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
-		    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
-	    Tcl_DStringFree(&command);
-
-	    if ((code != TCL_OK) && (code != TCL_ERROR)) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"bad return code: %d", code));
-		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
-		code = TCL_ERROR;
-	    }
-	    if (code == TCL_ERROR) {
-		Tcl_AddErrorInfo(interp,
-			"\n    (\"package unknown\" script)");
-		return NULL;
-	    }
-	    Tcl_ResetResult(interp);
+	if (statePtr->availStable) {
+	    statePtr->bestStablePtr = statePtr->availPtr;
 	}
     }
 
+    if (statePtr->bestVersion != NULL) {
+	ckfree(statePtr->bestVersion);
+    }
+
+    /*
+     * Now choose a version among the two best. For 'latest' we simply
+     * take (actually keep) the best. For 'stable' we take the best
+     * stable, if there is any, or the best if there is nothing stable.
+     */
+
+    if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
+	    && (statePtr->bestStablePtr != NULL)) {
+	statePtr->bestPtr = statePtr->bestStablePtr;
+    }
+
+    if (statePtr->bestPtr != NULL) {
+	TclNRAddCallback(
+	    interp, PkgRequireCoreBestFinish, statePtr, reqv, NULL, NULL);
+	TclNRAddCallback(
+	    interp, PkgRequireCoreBest, statePtr, NULL, NULL, NULL);
+	return TCL_OK;
+    }
+
+    /*
+     * The package is not in the database. If there is a "package unknown"
+     * command, invoke it (but only on the first pass; after that, we
+     * should not get here in the first place).
+     */
+
+    if (statePtr->pass > 1) {
+	Tcl_NRAddCallback(interp, PkgRequireCoreCheckFound,
+	    statePtr, (ClientData)reqv, NULL, NULL);
+	return TCL_OK;
+    }
+    TclNRAddCallback(
+	interp, PkgRequireCoreUnknownFinish, statePtr,reqv, NULL, NULL);
+    TclNRAddCallback(
+	interp, PkgRequireCoreUnknown, statePtr,reqv, NULL, NULL);
+    return TCL_OK;
+}
+
+int
+PkgRequireCoreUnknown(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    Interp *iPtr = (Interp *) interp;
+    PkgRequireState *statePtr = data[0];
+    Tcl_Obj *const *reqv = data[1];
+    Tcl_DString command;
+    char *script;
+
+    script = ((Interp *) interp)->packageUnknown;
+    if (script != NULL) {
+	Tcl_DStringInit(&command);
+	Tcl_DStringAppend(&command, script, -1);
+	Tcl_DStringAppendElement(&command, statePtr->name);
+	AddRequirementsToDString(&command, statePtr->reqc, reqv);
+
+	statePtr->scriptObj = Tcl_NewStringObj(Tcl_DStringValue(&command), -1);
+	/* No need to increment of the ref count of scriptObj, because
+	 * TclNREvelObjEx does that.  right?
+	*/
+	Tcl_DStringFree(&command);
+	TclNRAddCallback(
+	    interp, PkgRequireCoreUnknownEvalFinish, statePtr, data[1], NULL, NULL);
+	statePtr->code = TclNREvalObjEx(
+	    interp, statePtr->scriptObj, TCL_EVAL_GLOBAL, iPtr->cmdFramePtr, 1);
+    }
+    return result;
+}
+int
+PkgRequireCoreUnknownEvalFinish(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    PkgRequireState *statePtr = data[0];
+
+    /* Pick up the return code from TclNREvalObjEx */
+    statePtr->code = result;
+
+    if ((statePtr->code != TCL_OK) && (statePtr->code != TCL_ERROR)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"bad return code: %d", statePtr->code));
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+	statePtr->code = TCL_ERROR;
+    }
+    if (statePtr->code == TCL_ERROR) {
+	Tcl_AddErrorInfo(interp,
+		"\n    (\"package unknown\" script)");
+	return TCL_ERROR;
+    }
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
+
+int
+PkgRequireCoreUnknownFinish(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    PkgRequireState *statePtr = data[0];
+    if (statePtr->code != TCL_OK) {
+	/* error message has been set */
+	TclNRAddCallback(
+	    interp, PkgRequireCoreFinish, statePtr, NULL, NULL, NULL);
+	return TCL_ERROR;
+    }
+    statePtr->pass++;
+    Tcl_NRAddCallback(interp, PkgRequireCore, statePtr, data[1], NULL, NULL);
+    return TCL_OK;
+}
+int
+PkgRequireCoreBest(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    Interp *iPtr = (Interp *) interp;
+    PkgRequireState *statePtr = data[0];
+    char *script;
+
+    /*
+     * We found an ifneeded script for the package. Be careful while
+     * executing it: this could cause reentrancy, so (a) protect the
+     * script itself from deletion and (b) don't assume that bestPtr
+     * will still exist when the script completes.
+     */
+
+    statePtr->versionToProvide = statePtr->bestPtr->version;
+
+    script = statePtr->bestPtr->script;
+    statePtr->pkgPtr->clientData = statePtr->versionToProvide;
+    Tcl_Preserve(statePtr->versionToProvide);
+    statePtr->scriptObj = Tcl_NewStringObj(script, -1);
+    Tcl_IncrRefCount(statePtr->scriptObj);
+    TclNRAddCallback(
+	interp, PkgRequireCoreBestEvalFinish, statePtr, data[1], NULL, NULL);
+    TclNREvalObjEx(
+	interp, statePtr->scriptObj, TCL_EVAL_GLOBAL , iPtr->cmdFramePtr, 0);
+
+    return result;
+}
+
+int
+PkgRequireCoreBestEvalFinish(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    PkgRequireState *statePtr = data[0];
+
+    /* Pick up the return code from TclNREvalObjEx */
+    statePtr->code = result;
+
+    Tcl_DecrRefCount(statePtr->scriptObj);
+
+    statePtr->pkgPtr = FindPackage(interp, statePtr->name);
+    if (statePtr->code == TCL_OK) {
+	Tcl_ResetResult(interp);
+	if (statePtr->pkgPtr->version == NULL) {
+	    statePtr->code = TCL_ERROR;
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "attempt to provide package %s %s failed:"
+		    " no version of package %s provided",
+		    statePtr->name, statePtr->versionToProvide, statePtr->name));
+	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
+		    NULL);
+	} else {
+	    char *pvi, *vi;
+
+	    if (CheckVersionAndConvert(interp, statePtr->pkgPtr->version, &pvi,
+		    NULL) != TCL_OK) {
+		statePtr->code = TCL_ERROR;
+	    } else if (CheckVersionAndConvert(interp,
+		    statePtr->versionToProvide, &vi, NULL) != TCL_OK) {
+		ckfree(pvi);
+		statePtr->code = TCL_ERROR;
+	    } else {
+		int res = CompareVersions(pvi, vi, NULL);
+
+		ckfree(pvi);
+		ckfree(vi);
+		if (res != 0) {
+		    statePtr->code = TCL_ERROR;
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "attempt to provide package %s %s failed:"
+			    " package %s %s provided instead",
+			    statePtr->name, statePtr->versionToProvide,
+			    statePtr->name, statePtr->pkgPtr->version));
+		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
+			    "WRONGPROVIDE", NULL);
+		}
+	    }
+	}
+    } else if (statePtr->code != TCL_ERROR) {
+	Tcl_Obj *codePtr = Tcl_NewIntObj(statePtr->code);
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"attempt to provide package %s %s failed:"
+		" bad return code: %s",
+		statePtr->name, statePtr->versionToProvide, TclGetString(codePtr)));
+	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+	TclDecrRefCount(codePtr);
+	statePtr->code = TCL_ERROR;
+    }
+
+    if (statePtr->code == TCL_ERROR) {
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (\"package ifneeded %s %s\" script)",
+	    statePtr->name, statePtr->versionToProvide));
+    }
+    return result;
+}
+
+int
+PkgRequireCoreBestFinish(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    PkgRequireState *statePtr = data[0];
+
+    if (statePtr->code == TCL_ERROR) {
+	/*
+	 * Take a non-TCL_OK code from the script as an indication the
+	 * package wasn't loaded properly, so the package system
+	 * should not remember an improper load.
+	 *
+	 * This is consistent with our returning NULL. If we're not
+	 * willing to tell our caller we got a particular version, we
+	 * shouldn't store that version for telling future callers
+	 * either.
+	 */
+
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"package ifneeded %s %s\" script)",
+		statePtr->name, statePtr->versionToProvide));
+
+	if (statePtr->pkgPtr->version != NULL) {
+	    ckfree(statePtr->pkgPtr->version);
+	    statePtr->pkgPtr->version = NULL;
+	}
+	statePtr->pkgPtr->clientData = NULL;
+	TclNRAddCallback(
+	    interp, PkgRequireCoreFinish, statePtr, NULL, NULL, NULL);
+    } else {
+	Tcl_NRAddCallback(interp, PkgRequireCoreCheckFound, statePtr, data[1], NULL, NULL);
+    }
+    Tcl_Release(statePtr->versionToProvide);
+    return result;
+}
+
+int
+PkgRequireCoreCheckFound(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    PkgRequireState *statePtr = data[0];
+    Tcl_Obj *const *reqv = data[1];
+    Package *pkgPtr = statePtr->pkgPtr;
+    int satisfies;
+
+    Tcl_NRAddCallback(interp, PkgRequireCoreFinish, statePtr, NULL, NULL,NULL);
     if (pkgPtr->version == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't find package %s", name));
+		"can't find package %s", statePtr->name));
 	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
-	AddRequirementsToResult(interp, reqc, reqv);
-	return NULL;
+	AddRequirementsToResult(interp, statePtr->reqc, reqv);
+	return TCL_ERROR;
     }
 
     /*
@@ -626,30 +817,48 @@ PkgRequireCore(
      * provided version meets the current requirements.
      */
 
-    if (reqc != 0) {
-	CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
-	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
+    if (statePtr->reqc != 0) {
+	CheckVersionAndConvert(interp, pkgPtr->version, &statePtr->pkgVersionI, NULL);
+	satisfies = SomeRequirementSatisfied(statePtr->pkgVersionI, statePtr->reqc, reqv);
 
-	ckfree(pkgVersionI);
+	ckfree(statePtr->pkgVersionI);
 
 	if (!satisfies) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "version conflict for package \"%s\": have %s, need",
-		    name, pkgPtr->version));
+		    statePtr->name, pkgPtr->version));
 	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
 		    NULL);
-	    AddRequirementsToResult(interp, reqc, reqv);
-	    return NULL;
+	    AddRequirementsToResult(interp, statePtr->reqc, reqv);
+	    return TCL_ERROR;
 	}
     }
 
-    if (clientDataPtr) {
-	const void **ptr = (const void **) clientDataPtr;
-
+    if (statePtr->clientDataPtr) {
+	const void **ptr = (const void **) statePtr->clientDataPtr;
 	*ptr = pkgPtr->clientData;
     }
-    return pkgPtr->version;
+    statePtr->result = pkgPtr->version;
+    return TCL_OK;
 }
+
+int
+PkgRequireCoreFinish(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result
+) {
+    PkgRequireState *statePtr = data[0];
+    if (statePtr->result == NULL) {
+	result = TCL_ERROR;
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(statePtr->result, -1));
+	result = TCL_OK;
+    }
+    ckfree(statePtr);
+    return result;
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -756,13 +965,24 @@ Tcl_PkgPresentEx(
  */
 
 	/* ARGSUSED */
+
 int
 Tcl_PackageObjCmd(
     ClientData dummy,		/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
+    Tcl_Obj *const objv[]	/* Argument objects. */
+) {
+    return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRPackageObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[]	/* Argument objects. */
+) {
     static const char *const pkgOptions[] = {
 	"forget",  "ifneeded", "names",   "prefer",   "present",
 	"provide", "require",  "unknown", "vcompare", "versions",
@@ -976,7 +1196,7 @@ Tcl_PackageObjCmd(
 	}
 	return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
     case PKG_REQUIRE:
-    require:
+    require: {
 	if (objc < 3) {
 	requireSyntax:
 	    Tcl_WrongNumArgs(interp, 2, objv,
@@ -988,13 +1208,11 @@ Tcl_PackageObjCmd(
 
 	argv2 = TclGetString(objv[2]);
 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
-	    Tcl_Obj *ov;
-	    int res;
-
+	    Tcl_Obj ** objv2;
 	    if (objc != 5) {
 		goto requireSyntax;
 	    }
-
+	    objv2 = ckalloc((sizeof(Tcl_Obj *)));
 	    version = TclGetString(objv[4]);
 	    if (CheckVersionAndConvert(interp, version, NULL,
 		    NULL) != TCL_OK) {
@@ -1005,22 +1223,34 @@ Tcl_PackageObjCmd(
 	     * Create a new-style requirement for the exact version.
 	     */
 
-	    ov = Tcl_NewStringObj(version, -1);
-	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
-	    version = NULL;
+	    objv2[0] = Tcl_NewStringObj(version, -1);
+	    Tcl_IncrRefCount(objv2[0]);
+	    Tcl_AppendStringsToObj(objv2[0], "-", version, NULL);
 	    argv3 = TclGetString(objv[3]);
+	    Tcl_IncrRefCount(objv[3]);
 
-	    Tcl_IncrRefCount(ov);
-	    res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
-	    TclDecrRefCount(ov);
-	    return res;
+	    TclNRAddCallback(interp, TclPkgRequireProcFinish, 
+		INT2PTR(1), objv2, objv[3], NULL);
+	    TclNRAddCallback(interp, TclNRPkgRequireProc, argv3, 1, objv2, NULL);
+	    return TCL_OK;
 	} else {
+	    Tcl_Obj ** objv2;
 	    if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+	    objv2 = ckalloc((objc-3)*(sizeof(Tcl_Obj *)));
+	    for (i = 3; i < objc; i++) {
+		objv2[i-3] = objv[i];
+		Tcl_IncrRefCount(objv[i]);
+	    }
 
-	    return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
+	    TclNRAddCallback(interp, TclPkgRequireProcFinish,
+		INT2PTR(objc-3), objv2, NULL, NULL);
+	    TclNRAddCallback(interp, TclNRPkgRequireProc, argv2,
+		INT2PTR(objc-3), objv2, NULL);
+	    return TCL_OK;
 	}
+    }
 	break;
     case PKG_UNKNOWN: {
 	int length;

generic/tclStringObj.c

@@ -379,6 +379,7 @@ Tcl_NewUnicodeObj(
     Tcl_Obj *objPtr;
 
     TclNewObj(objPtr);
+    TclStringSetPrev(objPtr, NULL); 
     SetUnicodeObj(objPtr, unicode, numChars);
     return objPtr;
 }
@@ -421,6 +422,7 @@ Tcl_GetCharLength(
 	return length;
     }
 
+
     /*
      * OK, need to work with the object as a string.
      */
@@ -439,6 +441,50 @@ Tcl_GetCharLength(
     }
     return numChars;
 }
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCheckEmptyString --
+ *
+ *	Determine whether the string value of an object is or would be the
+ *	empty string, without generating a string representation.
+ *
+ * Results:
+ *	Returns 1 if empty, 0 if not, and -1 if unknown.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclCheckEmptyString (
+    Tcl_Obj *objPtr
+) {
+    int length = -1;
+
+    if (objPtr->bytes == tclEmptyStringRep) {
+	return TCL_EMPTYSTRING_YES;
+    }
+
+    if (TclIsPureList(objPtr)) {
+	Tcl_ListObjLength(NULL, objPtr, &length);
+	return length == 0;
+    }
+
+    if (TclIsPureDict(objPtr)) {
+	Tcl_DictObjSize(NULL, objPtr, &length);
+	return length == 0;
+    }
+
+    if (objPtr->bytes == NULL) {
+	return TCL_EMPTYSTRING_UNKNOWN;
+    }
+    return objPtr->length == 0;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -942,11 +988,17 @@ Tcl_SetUnicodeObj(
     int numChars)		/* Number of characters in the unicode
 				 * string. */
 {
+    Tcl_Obj *prevPtr = NULL;
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
     }
+    if (objPtr->typePtr != NULL && objPtr->typePtr != &tclStringType) {
+	prevPtr = Tcl_DuplicateObj(objPtr);
+	Tcl_IncrRefCount(prevPtr);
+    }
     TclFreeIntRep(objPtr);
     SetUnicodeObj(objPtr, unicode, numChars);
+    TclStringSetPrev(objPtr, prevPtr); 
 }
 
 static int
@@ -992,7 +1044,6 @@ SetUnicodeObj(
     stringPtr->unicode[numChars] = 0;
     stringPtr->numChars = numChars;
     stringPtr->hasUnicode = 1;
-
     TclInvalidateStringRep(objPtr);
     stringPtr->allocated = 0;
 }
@@ -1328,6 +1379,9 @@ AppendUnicodeToUnicodeRep(
     }
 
     SetStringFromAny(NULL, objPtr);
+    if (appendNumChars > 0) {
+	TclStringInvalidatePrev(objPtr);
+    }
     stringPtr = GET_STRING(objPtr);
 
     /*
@@ -1481,6 +1535,7 @@ AppendUtfToUtfRep(
     if (numBytes == 0) {
 	return;
     }
+    TclStringInvalidatePrev(objPtr);
 
     /*
      * Copy the new string onto the end of the old string, then add the
@@ -2782,6 +2837,9 @@ ExtendUnicodeRepWithString(
     if (numAppendChars == -1) {
 	TclNumUtfChars(numAppendChars, bytes, numBytes);
     }
+    if (numAppendChars > 0) {
+	TclStringInvalidatePrev(objPtr);
+    }
     needed = numOrigChars + numAppendChars;
     stringCheckLimits(needed);
 
@@ -2829,6 +2887,7 @@ DupStringInternalRep(
 {
     String *srcStringPtr = GET_STRING(srcPtr);
     String *copyStringPtr = NULL;
+    Tcl_Obj *prevPtr;
 
     if (srcStringPtr->numChars == -1) {
 	/*
@@ -2870,10 +2929,15 @@ DupStringInternalRep(
      * code, so it doesn't contain any extra bytes that might exist in the
      * source object.
      */
-
     copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
 
     SET_STRING(copyPtr, copyStringPtr);
+    prevPtr = TclStringGetPrev(srcPtr);
+    if (prevPtr != NULL) {
+	prevPtr = Tcl_DuplicateObj(prevPtr);
+	Tcl_IncrRefCount(prevPtr);
+    }
+    TclStringSetPrev(copyPtr, prevPtr);
     copyPtr->typePtr = &tclStringType;
 }
 
@@ -2901,6 +2965,8 @@ SetStringFromAny(
 {
     if (objPtr->typePtr != &tclStringType) {
 	String *stringPtr = stringAlloc(0);
+	Tcl_Obj *prevPtr = Tcl_DuplicateObj(objPtr);
+	Tcl_IncrRefCount(prevPtr);
 
 	/*
 	 * Convert whatever we have into an untyped value. Just A String.
@@ -2919,6 +2985,7 @@ SetStringFromAny(
 	stringPtr->maxChars = 0;
 	stringPtr->hasUnicode = 0;
 	SET_STRING(objPtr, stringPtr);
+	TclStringSetPrev(objPtr, prevPtr);
 	objPtr->typePtr = &tclStringType;
     }
     return TCL_OK;
@@ -2977,6 +3044,7 @@ ExtendStringRepWithUnicode(
     if (numChars == 0) {
 	return 0;
     }
+    TclStringInvalidatePrev(objPtr);
 
     if (objPtr->bytes == NULL) {
 	objPtr->length = 0;
@@ -3038,10 +3106,23 @@ static void
 FreeStringInternalRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
+    Tcl_Obj * prevPtr = TclStringGetPrev(objPtr);
+    if (prevPtr != NULL) {
+	Tcl_DecrRefCount(prevPtr);
+    }
     ckfree(GET_STRING(objPtr));
     objPtr->typePtr = NULL;
 }
 
+static void InvalidateCachedReps(
+    Tcl_Obj *objPtr
+) {
+    Tcl_Obj * prevPtr = TclStringGetPrev(objPtr);
+    if (prevPtr != NULL) {
+	Tcl_DecrRefCount(TclStringGetPrev(objPtr));
+    }
+}
+
 /*
  * Local Variables:
  * mode: c

generic/tclThreadAlloc.c

@@ -624,6 +624,7 @@ TclThreadFreeObj(
 
     GETCACHE(cachePtr);
 
+
     /*
      * Get this thread's list and push on the free Tcl_Obj.
      */

tests/load.test

@@ -228,8 +228,8 @@ test load-9.1 {Tcl_StaticPackage, load already-loaded package into another inter
 test load-10.1 {load from vfs} \
     -constraints [list $dll $loaded testsimplefilesystem] \
     -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \
-    -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
-    -result {0 {}} \
+    -body {list [catch {load simplefs:/pkgd$ext pkgd} msg]} \
+    -result 0 \
     -cleanup {testsimplefilesystem 0; cd $dir; unset dir}
 
 test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \

tests/package.test

@@ -605,6 +605,18 @@ test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup
     package require t
     return $x
 } -result {1.3}
+test package-3.53 {Tcl_PkgRequire procedure, coroutine support} -setup {
+    package forget t
+} -body {
+    coroutine coro1 apply {{} {
+	package ifneeded t 2.1 {
+	    yield 
+	    package provide t 2.1
+	}
+	package require t 2.1
+    }}
+    list [catch {coro1} msg] $msg
+} -match glob -result {0 2.1} 
 
 test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
     package

tests/unload.test

@@ -86,7 +86,7 @@ test unload-2.1 {basic loading of non-unloadable package, with guess for package
 } {0 {pkga_eq pkga_quote}}
 test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
     list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
-	    [load [file join $testDir pkgua$ext]] \
+	    [load [file join $testDir pkgua$ext]; list] \
 	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
 	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
 } {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
@@ -110,7 +110,7 @@ test unload-2.5 {reloading of unloaded package, with guess for package name} -se
     }
 } -constraints [list $dll $loaded] -body {
     list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
-	    [load [file join $testDir pkgua$ext]] \
+	    [load [file join $testDir pkgua$ext]; list] \
 	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
 	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
 } -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
@@ -213,7 +213,7 @@ test unload-4.1 {loading of unloadable package in trusted interpreter, with gues
     incr load(M)
 } -constraints [list $dll $loaded] -body {
     list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
-	    [load [file join $testDir pkgua$ext]] \
+	    [load [file join $testDir pkgua$ext]; list] \
 	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
 	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
 } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}

unix/Makefile.in

@@ -718,6 +718,7 @@ gdb-test: ${TCLTEST_EXE}
 	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
 	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
 	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
+	@echo "$(GDBSCRIPT)" >> gdb.run
 	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
 	rm gdb.run
 

unix/tcl.m4

@@ -734,7 +734,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
     AC_MSG_CHECKING([for build with symbols])
     AC_ARG_ENABLE(symbols,
 	AC_HELP_STRING([--enable-symbols],
-	    [build with debugging symbols (default: off)]),
+	    [build with debugging symbols (all, compile, or mem) (default: off)]),
 	[tcl_ok=$enableval], [tcl_ok=no])
 # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
     DBGX=""