diff options
author | dgp <dgp@users.sourceforge.net> | 2012-11-30 17:00:16 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2012-11-30 17:00:16 (GMT) |
commit | de9166186fd76d3d1ddeaace858c9d8be3e96b9d (patch) | |
tree | 385552b7019b37caf88f631e931e1b60915b34f3 | |
parent | b2a578281bc651e13b8df894e7ad830511439372 (diff) | |
parent | 7f282b3594655176c8010e0a744c3deb798b76e2 (diff) | |
download | tcl-de9166186fd76d3d1ddeaace858c9d8be3e96b9d.zip tcl-de9166186fd76d3d1ddeaace858c9d8be3e96b9d.tar.gz tcl-de9166186fd76d3d1ddeaace858c9d8be3e96b9d.tar.bz2 |
Remove all maintenance of a string result in the Interp.
-rw-r--r-- | generic/tcl.h | 8 | ||||
-rw-r--r-- | generic/tclBasic.c | 90 | ||||
-rw-r--r-- | generic/tclHistory.c | 7 | ||||
-rw-r--r-- | generic/tclInt.h | 67 | ||||
-rw-r--r-- | generic/tclLoad.c | 12 | ||||
-rw-r--r-- | generic/tclResult.c | 346 | ||||
-rw-r--r-- | generic/tclStubLib.c | 6 | ||||
-rw-r--r-- | generic/tclStubLibCompat.c | 57 | ||||
-rw-r--r-- | generic/tclTest.c | 21 | ||||
-rw-r--r-- | generic/tclUtil.c | 76 | ||||
-rw-r--r-- | unix/Makefile.in | 10 | ||||
-rw-r--r-- | win/Makefile.in | 4 | ||||
-rw-r--r-- | win/makefile.vc | 1 |
13 files changed, 76 insertions, 629 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index a779947..162983b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -524,8 +524,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_BREAK 3 #define TCL_CONTINUE 4 -#define TCL_RESULT_SIZE 200 - /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): @@ -701,13 +699,7 @@ int Tcl_IsShared(Tcl_Obj *objPtr); */ typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4f3b77e..24a1082 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -485,8 +485,7 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = NULL; + iPtr->legacyResult = NULL; iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); @@ -542,10 +541,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -573,7 +568,6 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); - iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -1475,7 +1469,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1497,10 +1490,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2374,7 +2363,7 @@ TclInvokeStringCommand( * in the Command structure. * * Results: - * A standard Tcl string result value. + * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_CmdProc, @@ -2415,13 +2404,6 @@ TclInvokeObjectCommand( } /* - * Move the interpreter's object result to the string result, then reset - * the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ @@ -3423,7 +3405,7 @@ TclCleanupCommand( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -3435,8 +3417,8 @@ TclInterpReady( register Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -3954,24 +3936,9 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { - Interp *iPtr = (Interp *) interp; NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - * - * This only needs to be done for the first item in the list: all other - * are for NR function calls, and those are Tcl_Obj based. - */ - - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } - while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; @@ -5401,16 +5368,7 @@ Tcl_Eval( * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { - int code = Tcl_EvalEx(interp, script, -1, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; + return Tcl_EvalEx(interp, script, -1, 0); } /* @@ -5900,9 +5858,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -5929,9 +5884,6 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -5957,14 +5909,6 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } return result; } } @@ -6290,12 +6234,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -6399,19 +6337,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { - if (iPtr->result[0] != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * expect interp->result to continue to be set, so we'll take - * special pains to avoid clearing it, until we drop support for - * interp->result completely. - */ - - iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); - } else { - iPtr->errorInfo = iPtr->objResultPtr; - } + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -6489,7 +6415,7 @@ Tcl_VarEvalVA( * * Results: * A standard Tcl return result. An error message or other result may be - * left in interp->result. + * left in the interp. * * Side effects: * Depends on what was done by the command. diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b10d423..c44ba4c 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -75,13 +75,6 @@ Tcl_RecordAndEval( result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Discard the Tcl object created to hold the command. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 8110248..5192688 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1799,42 +1799,33 @@ typedef struct AllocCache { */ typedef struct Interp { + /* - * Note: the first three fields must match exactly the fields in a - * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the - * other. - * - * The interpreter's result is held in both the string and the - * objResultPtr fields. These fields hold, respectively, the result's - * string or object value. The interpreter's result is always in the - * result field if that is non-empty, otherwise it is in objResultPtr. - * The two fields are kept consistent unless some C code sets - * interp->result directly. Programs should not access result and - * objResultPtr directly; instead, they should always get and set the - * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and - * Tcl_GetStringResult. See the SetResult man page for details. + * The first two fields were named "result" and "freeProc" in earlier + * versions of Tcl. They are no longer used within Tcl, and are no + * longer available to be accessed by extensions. However, they cannot + * be removed. Why? There is a deployed base of stub-enabled extensions + * that query the value of iPtr->stubTable. For them to continue to work, + * the location of the field "stubTable" within the Interp struct cannot + * change. The most robust way to assure that is to leave all fields up to + * that one undisturbed. */ - char *result; /* If the last command returned a string - * result, this points to it. Should not be - * accessed directly; see comment above. */ - Tcl_FreeProc *freeProc; /* Zero means a string result is statically - * allocated. TCL_DYNAMIC means string result - * was allocated with ckalloc and should be - * freed with ckfree. Other values give - * address of procedure to invoke to free the - * string result. Tcl_Eval must free it before - * executing next command. */ + char *legacyResult; + Tcl_FreeProc *legacyFreeProc; int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. On - * previous versions of Tcl this is a pointer - * to the objResultPtr or a pointer to a - * buckets array in a hash table. We therefore - * have to do some careful checking before we - * can use this. */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultPtr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1847,8 +1838,6 @@ typedef struct Interp { ClientData interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */ - /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. @@ -1878,19 +1867,6 @@ typedef struct Interp { * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* - * Information used by Tcl_AppendResult to keep track of partial results. - * See Tcl_AppendResult code for details. - */ - - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ - - /* * Information about packages. Used only in tclPkg.c. */ @@ -1912,7 +1888,6 @@ typedef struct Interp { * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ - int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the @@ -1950,8 +1925,6 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ - char resultSpace[TCL_RESULT_SIZE+1]; - /* Static space holding small results. */ Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 5c47a6b..80efdd8 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -470,10 +470,14 @@ Tcl_LoadObjCmd( if (code != TCL_OK) { Interp *iPtr = (Interp *) target; - if (iPtr->result != NULL && iPtr->result[0] != '\0') { - /* We have an Tcl 8.x extension with incompatible stub table. */ - Tcl_Obj *obj = Tcl_NewStringObj(iPtr->result, -1); - Tcl_SetObjResult(target, obj); + if (iPtr->legacyResult != NULL) { + /* + * A call to Tcl_InitStubs() determined the caller extension and + * this interp are incompatible in their stubs mechanisms, and + * recorded the error in the oldest legacy place we have to do so. + */ + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); + iPtr->legacyResult = NULL; } Tcl_TransferResult(target, code, interp); goto done; diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..b8f9c92 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,7 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -static void SetupAppendBuffer(Interp *iPtr, int newSpace); /* * This structure is used to take a snapshot of the interpreter state in @@ -246,44 +245,6 @@ Tcl_SaveResult( statePtr->objResultPtr = iPtr->objResultPtr; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); - - /* - * Save the string result. - */ - - statePtr->freeProc = iPtr->freeProc; - if (iPtr->result == iPtr->resultSpace) { - /* - * Copy the static string data out of the interp buffer. - */ - - statePtr->result = statePtr->resultSpace; - strcpy(statePtr->result, iPtr->result); - statePtr->appendResult = NULL; - } else if (iPtr->result == iPtr->appendResult) { - /* - * Move the append buffer out of the interp. - */ - - statePtr->appendResult = iPtr->appendResult; - statePtr->appendAvl = iPtr->appendAvl; - statePtr->appendUsed = iPtr->appendUsed; - statePtr->result = statePtr->appendResult; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - } else { - /* - * Move the dynamic or static string out of the interpreter. - */ - - statePtr->result = iPtr->result; - statePtr->appendResult = NULL; - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - iPtr->freeProc = 0; } /* @@ -314,39 +275,6 @@ Tcl_RestoreResult( Tcl_ResetResult(interp); /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } - - /* * Restore the object result. */ @@ -377,14 +305,6 @@ Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { TclDecrRefCount(statePtr->objResultPtr); - - if (statePtr->result == statePtr->appendResult) { - ckfree(statePtr->appendResult); - } else if (statePtr->freeProc == TCL_DYNAMIC) { - ckfree(statePtr->result); - } else if (statePtr->freeProc) { - statePtr->freeProc(statePtr->result); - } } /* @@ -414,49 +334,15 @@ Tcl_SetResult( * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { - Interp *iPtr = (Interp *) interp; - register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; - char *oldResult = iPtr->result; - - if (result == NULL) { - iPtr->resultSpace[0] = 0; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } else if (freeProc == TCL_VOLATILE) { - int length = strlen(result); - - if (length > TCL_RESULT_SIZE) { - iPtr->result = ckalloc(length + 1); - iPtr->freeProc = TCL_DYNAMIC; - } else { - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } - memcpy(iPtr->result, result, (unsigned) length+1); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); + if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { + return; } - - /* - * If the old result was dynamically-allocated, free it up. Do it here, - * rather than at the beginning, in case the new result value was part of - * the old result value. - */ - - if (oldFreeProc != 0) { - if (oldFreeProc == TCL_DYNAMIC) { - ckfree(oldResult); - } else { - oldFreeProc(oldResult); - } + if (freeProc == TCL_DYNAMIC) { + ckfree(result); + } else { + (*freeProc)(result); } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); } /* @@ -480,18 +366,9 @@ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - Interp *iPtr = (Interp *) interp; - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; + return Tcl_GetString(iPtr->objResultPtr); } /* @@ -532,21 +409,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - - /* - * Reset the string result since we just set the result object. - */ - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; } /* @@ -575,32 +437,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - - if (iPtr->result[0] != 0) { - ResetObjResult(iPtr); - objResultPtr = iPtr->objResultPtr; - length = strlen(iPtr->result); - TclInitStringRep(objResultPtr, iPtr->result, length); - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->result[0] = 0; - } return iPtr->objResultPtr; } @@ -719,129 +556,20 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; - char *dst; - int size; - int flags; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* - * See how much space is needed, and grow the append buffer if needed to - * accommodate the list element. - */ - - size = Tcl_ScanElement(element, &flags) + 1; - if ((iPtr->result != iPtr->appendResult) - || (iPtr->appendResult[iPtr->appendUsed] != 0) - || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { - SetupAppendBuffer(iPtr, size+iPtr->appendUsed); - } - - /* - * Convert the string into a list element and copy it to the buffer that's - * forming, with a space separator if needed. - */ - - dst = iPtr->appendResult + iPtr->appendUsed; - if (TclNeedSpace(iPtr->appendResult, dst)) { - iPtr->appendUsed++; - *dst = ' '; - dst++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; - } - iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); -} - -/* - *---------------------------------------------------------------------- - * - * SetupAppendBuffer -- - * - * This function makes sure that there is an append buffer properly - * initialized, if necessary, from the interpreter's result, and that it - * has at least enough room to accommodate newSpace new bytes of - * information. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static void -SetupAppendBuffer( - Interp *iPtr, /* Interpreter whose result is being set up. */ - int newSpace) /* Make sure that at least this many bytes of - * new information may be added. */ -{ - int totalSpace; - - /* - * Make the append buffer larger, if that's necessary, then copy the - * result into the append buffer and make the append buffer the official - * Tcl result. - */ - - if (iPtr->result != iPtr->appendResult) { - /* - * If an oversized buffer was used recently, then free it up so we go - * back to a smaller buffer. This avoids tying up memory forever after - * a large operation. - */ - - if (iPtr->appendAvl > 500) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - } - iPtr->appendUsed = strlen(iPtr->result); - } else if (iPtr->result[iPtr->appendUsed] != 0) { - /* - * Most likely someone has modified a result created by - * Tcl_AppendResult et al. so that it has a different size. Just - * recompute the size. - */ - - iPtr->appendUsed = strlen(iPtr->result); - } - - totalSpace = newSpace + iPtr->appendUsed; - if (totalSpace >= iPtr->appendAvl) { - char *new; - - if (totalSpace < 100) { - totalSpace = 200; - } else { - totalSpace *= 2; - } - new = ckalloc(totalSpace); - strcpy(new, iPtr->result); - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - iPtr->appendResult = new; - iPtr->appendAvl = totalSpace; - } else if (iPtr->result != iPtr->appendResult) { - strcpy(iPtr->appendResult, iPtr->result); + Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); + Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); + int length; + const char *bytes; + + if (Tcl_IsShared(iPtr->objResultPtr)) { + Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); + } + bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length); + if (TclNeedSpace(bytes, bytes+length)) { + Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; + Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); + Tcl_DecrRefCount(listPtr); } /* @@ -850,18 +578,17 @@ SetupAppendBuffer( * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. + * result, resetting the interpreter's result object. Tcl_FreeResult is + * most commonly used when a function is about to replace one result + * value with another. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. + * Frees the memory associated with interp's result but does not change + * any part of the error dictionary (i.e., the errorinfo and errorcode + * remain the same). * *---------------------------------------------------------------------- */ @@ -872,15 +599,6 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - ResetObjResult(iPtr); } @@ -910,16 +628,6 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 5914deb..501072c 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -46,9 +46,9 @@ HasStubSupport( if (iPtr->stubTable && iPtr->stubTable->magic == magic) { return iPtr->stubTable; } - iPtr->result = - (char *) "interpreter uses an incompatible stubs mechanism"; - iPtr->freeProc = TCL_STATIC; + iPtr->legacyResult + = (char *) "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = TCL_STATIC; return NULL; } diff --git a/generic/tclStubLibCompat.c b/generic/tclStubLibCompat.c deleted file mode 100644 index b73c626..0000000 --- a/generic/tclStubLibCompat.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * tclStubLibCompat.c -- - * - * Stub object that will be statically linked into extensions that want - * to access Tcl. - * - * Copyright (c) 2012 Jan Nijtmans - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -/* - * Small wrapper, which allows Tcl8 extensions to use the same stub - * library as Tcl 9. - */ - -#include "tclInt.h" - - -/* - *---------------------------------------------------------------------- - * - * Tcl_InitStubs -- - * - * Tries to initialise the stub table pointers and ensures that the - * correct version of Tcl is loaded. - * - * Results: - * The actual version of Tcl that satisfies the request, or NULL to - * indicate that an error occurred. - * - * Side effects: - * Sets the stub table pointers. - * - *---------------------------------------------------------------------- - */ -#undef Tcl_InitStubs - -MODULE_SCOPE const char * -Tcl_InitStubs( - Tcl_Interp *interp, - const char *version, - int exact) -{ - /* Use the hardcoded Tcl8 magic value here. */ - return TclInitStubs(interp, version, exact, "8.x", (int) 0xFCA3BACF); -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ - diff --git a/generic/tclTest.c b/generic/tclTest.c index 07be9e9..9b958dd 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -108,13 +108,6 @@ typedef struct TclEncoding { } TclEncoding; /* - * The counter below is used to determine if the TestsaveresultFree routine - * was called for a result. - */ - -static int freeCount; - -/* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ @@ -4869,7 +4862,6 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -4920,7 +4912,6 @@ TestsaveresultCmd( break; } - freeCount = 0; Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { @@ -4937,14 +4928,10 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { - int present = iPtr->freeProc == TestsaveresultFree; - int called = freeCount; - - Tcl_AppendElement(interp, called ? "called" : "notCalled"); - Tcl_AppendElement(interp, present ? "present" : "missing"); + case RESULT_DYNAMIC: + Tcl_AppendElement(interp, discard ? "called" : "notCalled"); + Tcl_AppendElement(interp, !discard ? "present" : "missing"); break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); @@ -4975,7 +4962,7 @@ static void TestsaveresultFree( char *blockPtr) { - freeCount++; + /* empty... */ } /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index cad6e4a..4b69628 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2762,7 +2762,6 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { - Tcl_ResetResult(interp); Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); } @@ -2792,77 +2791,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no st`ring result, we only have to deal with two cases: - * - * 1. When the string rep is the empty string, when we don't copy but - * instead use the staticSpace in the DString to hold an empty string. - - * 2. When the string rep is not there or there's a real string rep, when - * we use Tcl_GetString to fetch (or generate) the string rep - which - * we know to have been allocated with ckalloc() - and use it to - * populate the DString space. Then, we free the internal rep. and set - * the object's string representation back to the canonical empty - * string. - */ - - if (!iPtr->result[0] && iPtr->objResultPtr - && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == tclEmptyStringRep) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->string[0] = 0; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = Tcl_GetString(iPtr->objResultPtr); - dsPtr->length = iPtr->objResultPtr->length; - dsPtr->spaceAvl = dsPtr->length + 1; - TclFreeIntRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = tclEmptyStringRep; - iPtr->objResultPtr->length = 0; - } - return; - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - } + int length; + char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; + Tcl_DStringFree(dsPtr); + Tcl_DStringAppend(dsPtr, bytes, length); + Tcl_ResetResult(interp); } /* diff --git a/unix/Makefile.in b/unix/Makefile.in index 9a7d6db..4f66646 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -335,11 +335,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o -STUB_LIB_OBJS = tclStubLib.o \ - tclStubLibCompat.o \ - tclTomMathStubLib.o \ - tclOOStubLib.o \ - ${COMPAT_OBJS} +STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \ @@ -472,7 +468,6 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ - $(GENERIC_DIR)/tclStubLibCompat.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c @@ -1661,9 +1656,6 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c -tclStubLibCompat.o: $(GENERIC_DIR)/tclStubLibCompat.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLibCompat.c - tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c diff --git a/win/Makefile.in b/win/Makefile.in index 6b9685d..dacbbb5 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -378,7 +378,6 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ - tclStubLibCompat.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) @@ -506,9 +505,6 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c # The following objects are part of the stub library and should not be built # as DLL objects but none of the symbols should be exported -tclStubLibCompat.${OBJEXT}: tclStubLibCompat.c - $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) - tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) diff --git a/win/makefile.vc b/win/makefile.vc index 823142f..2784140 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -448,7 +448,6 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ - $(TMP_DIR)\tclStubLibCompat.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ $(TMP_DIR)\tclOOStubLib.obj |