Compare commits

...
Author SHA1 Message Date
dgp 0ebbd86bb7 revert mistaken commit 2012-11-16 22:56:36 +00:00
dgp e9cf99c212 merge trunk 2012-11-16 22:51:18 +00:00
dgp b339d4bf03 merge trunk 2012-07-19 15:08:23 +00:00
dgp 1e58e8e42d Implement Tcl_DStringResult with call to TclDStringToObj. 2012-04-25 21:03:58 +00:00
dgp 91af7f6f90 merge trunk 2012-04-25 21:02:42 +00:00
dgp 68191ded75 To preserve the ability of [load] to bring in mistmatched stubs-enabled
modules and react with an error rather than a crash, HasStubSupport() has
to keep fiddling with the same fields as always.
2012-04-19 12:57:45 +00:00
dkf ac3d0b69d3 Clean version of changes; ifdef-free 2012-04-19 12:41:06 +00:00
dkf 96f611f896 merge trunk 2012-04-19 12:20:49 +00:00
dgp ec9c29c80d Experimental branch where the interp->result field and related are removed
and all simplifications that makes possible are done.  Seems this can at best
be a Tcl 9 reform.
2012-04-18 18:42:54 +00:00
8 changed files with 64 additions and 566 deletions
+7 -39
View File
@@ -498,39 +498,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
*/
typedef struct Tcl_Interp
#ifndef TCL_NO_DEPRECATED
{
/* TIP #330: Strongly discourage extensions from using the string
* result. */
#ifdef USE_INTERP_RESULT
char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
/* If the last command returned a string
* result, this points to it. */
void (*freeProc) (char *blockPtr)
TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
/* Zero means the string result is statically
* allocated. TCL_DYNAMIC means it was
* allocated with ckalloc and should be freed
* with ckfree. Other values give the address
* of function to invoke to free the result.
* Tcl_Eval must free it before executing next
* command. */
#else
char *resultDontUse; /* Don't use in extensions! */
void (*freeProcDontUse) (char *); /* Don't use in extensions! */
#endif
#ifdef USE_INTERP_ERRORLINE
int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
/* When TCL_ERROR is returned, this gives the
* line number within the command where the
* error occurred (1 if first line). */
#else
int errorLineDontUse; /* Don't use in extensions! */
#endif
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Interp;
typedef struct Tcl_Interp Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -872,13 +840,13 @@ int Tcl_IsShared(Tcl_Obj *objPtr);
*/
typedef struct Tcl_SavedResult {
char *result;
Tcl_FreeProc *freeProc;
char *unused1;
Tcl_FreeProc *unused2;
Tcl_Obj *objResultPtr;
char *appendResult;
int appendAvl;
int appendUsed;
char resultSpace[TCL_RESULT_SIZE+1];
char *unused3;
int unused4;
int unused5;
char unused6[TCL_RESULT_SIZE+1];
} Tcl_SavedResult;
/*
+7 -82
View File
@@ -502,8 +502,6 @@ Tcl_CreateInterp(void)
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = NULL;
iPtr->errorLine = 0;
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
@@ -559,10 +557,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;
@@ -590,7 +584,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 */
@@ -1492,7 +1485,6 @@ DeleteInterpProc(
*/
Tcl_FreeResult(interp);
iPtr->result = NULL;
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = NULL;
Tcl_DecrRefCount(iPtr->ecVar);
@@ -1514,10 +1506,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);
@@ -2391,7 +2379,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,
@@ -2431,13 +2419,6 @@ TclInvokeObjectCommand(
cmdPtr->objClientData, argc, objv);
}
/*
* 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.
@@ -3794,7 +3775,7 @@ Tcl_ListMathFuncs(
* otherwise.
*
* Side effects:
* The interpreters object and string results are cleared.
* The interpreter's result is cleared.
*
*----------------------------------------------------------------------
*/
@@ -3806,8 +3787,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);
@@ -4325,24 +4306,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;
@@ -5820,16 +5786,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);
}
/*
@@ -6327,9 +6284,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;
}
@@ -6356,9 +6310,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;
}
@@ -6384,14 +6335,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;
}
}
@@ -6717,12 +6660,6 @@ Tcl_ExprString(
Tcl_DecrRefCount(resultPtr);
}
}
/*
* Force the string rep of the interp result.
*/
(void) Tcl_GetStringResult(interp);
return code;
}
@@ -6826,19 +6763,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);
@@ -6916,7 +6841,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.
-7
View File
@@ -74,13 +74,6 @@ Tcl_RecordAndEval(
Tcl_IncrRefCount(cmdPtr);
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.
*/
+12 -28
View File
@@ -1804,27 +1804,16 @@ typedef struct Interp {
* 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 interpreter's result is held in the objResultPtr field. This field
* holds the result's object value. The interpreter's result is always in
* objResultPtr. Programs should not access 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.
*/
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 *unused3;
Tcl_FreeProc *unused4;
int errorLine; /* When TCL_ERROR is returned, this gives the
* line number in the command where the error
* occurred (1 means first line). */
@@ -1882,13 +1871,9 @@ typedef struct Interp {
* 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. */
char *unused5;
int unused6;
int unused7;
/*
* Information about packages. Used only in tclPkg.c.
@@ -1950,8 +1935,7 @@ 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. */
char unused8[TCL_RESULT_SIZE+1];
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
+26 -318
View File
@@ -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;
}
/*
@@ -313,39 +274,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);
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
return;
}
if (freeProc == TCL_DYNAMIC) {
ckfree(result);
} else {
iPtr->result = (char *) result;
iPtr->freeProc = freeProc;
(*freeProc)(result);
}
/*
* 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);
}
}
/*
* 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;
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
int length;
const char *bytes;
/*
* 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);
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);
}
/*
* 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_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) {
+3 -4
View File
@@ -41,10 +41,9 @@ HasStubSupport(
if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
return iPtr->stubTable;
}
iPtr->result =
(char *)"This interpreter does not support stubs-enabled extensions.";
iPtr->freeProc = TCL_STATIC;
iPtr->unused3
= "This interpreter does not support stubs-enabled extensions.";
iPtr->unused4 = TCL_STATIC;
return NULL;
}
+4 -17
View File
@@ -115,13 +115,6 @@ typedef struct TclEncoding {
char *fromUtfCmd;
} 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.
*/
@@ -5028,7 +5021,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;
@@ -5079,7 +5071,6 @@ TestsaveresultCmd(
break;
}
freeCount = 0;
Tcl_SaveResult(interp, &state);
if (((enum options) index) == RESULT_OBJECT) {
@@ -5096,14 +5087,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");
@@ -5134,7 +5121,7 @@ static void
TestsaveresultFree(
char *blockPtr)
{
freeCount++;
/* empty... */
}
/*
+5 -71
View File
@@ -2796,7 +2796,6 @@ Tcl_DStringResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
}
@@ -2826,77 +2825,12 @@ Tcl_DStringGetResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
Interp *iPtr = (Interp *) interp;
int length;
char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
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);
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
Tcl_DStringFree(dsPtr);
Tcl_DStringAppend(dsPtr, bytes, length);
Tcl_ResetResult(interp);
}
/*