summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdIL.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdIL.c')
-rw-r--r--generic/tclCmdIL.c162
1 files changed, 79 insertions, 83 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index c70ba23..f870245 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -29,7 +29,7 @@
typedef struct SortElement {
union { /* The value that we sorting by. */
const char *strValuePtr;
- long intValue;
+ Tcl_WideInt wideValue;
double doubleValue;
Tcl_Obj *objValuePtr;
} collationKey;
@@ -1147,41 +1147,38 @@ InfoFrameCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- int level, topLevel, code = TCL_OK;
- CmdFrame *runPtr, *framePtr;
+ int level, code = TCL_OK;
+ CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ int topLevel = 0;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?number?");
return TCL_ERROR;
}
- topLevel = ((iPtr->cmdFramePtr == NULL)
- ? 0
- : iPtr->cmdFramePtr->level);
-
- if (corPtr) {
- /*
- * A coroutine: must fix the level computations AND the cmdFrame chain,
- * which is interrupted at the base.
- */
-
- CmdFrame *lastPtr = NULL;
-
- runPtr = iPtr->cmdFramePtr;
+ while (corPtr) {
+ while (*cmdFramePtrPtr) {
+ topLevel++;
+ cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+ }
+ if (corPtr->caller.cmdFramePtr) {
+ *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+ }
+ corPtr = corPtr->callerEEPtr->corPtr;
+ }
+ topLevel += (*cmdFramePtrPtr)->level;
- /* TODO - deal with overflow */
- topLevel += corPtr->caller.cmdFramePtr->level;
- while (runPtr) {
- runPtr->level += corPtr->caller.cmdFramePtr->level;
- lastPtr = runPtr;
- runPtr = runPtr->nextPtr;
+ if (topLevel != iPtr->cmdFramePtr->level) {
+ framePtr = iPtr->cmdFramePtr;
+ while (framePtr) {
+ framePtr->level = topLevel--;
+ framePtr = framePtr->nextPtr;
}
- if (lastPtr) {
- lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
- } else {
- iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
+ if (topLevel) {
+ Tcl_Panic("Broken frame level calculation");
}
+ topLevel = iPtr->cmdFramePtr->level;
}
if (objc == 1) {
@@ -1231,20 +1228,27 @@ InfoFrameCmd(
Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
done:
- if (corPtr) {
+ cmdFramePtrPtr = &iPtr->cmdFramePtr;
+ corPtr = iPtr->execEnvPtr->corPtr;
+ while (corPtr) {
+ CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
+
+ if (endPtr) {
+ if (*cmdFramePtrPtr == endPtr) {
+ *cmdFramePtrPtr = NULL;
+ } else {
+ CmdFrame *runPtr = *cmdFramePtrPtr;
- if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
- iPtr->cmdFramePtr = NULL;
- } else {
- runPtr = iPtr->cmdFramePtr;
- while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
- runPtr->level -= corPtr->caller.cmdFramePtr->level;
- runPtr = runPtr->nextPtr;
+ while (runPtr->nextPtr != endPtr) {
+ runPtr->level -= endPtr->level;
+ runPtr = runPtr->nextPtr;
+ }
+ runPtr->level = 1;
+ runPtr->nextPtr = NULL;
}
- runPtr->level = 1;
- runPtr->nextPtr = NULL;
+ cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
}
-
+ corPtr = corPtr->callerEEPtr->corPtr;
}
return code;
}
@@ -1284,6 +1288,9 @@ TclInfoFrame(
};
Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+ /* Super ugly hack added to the pile so we can plug memleak */
+ int needsFree = -1;
+
/*
* Pull the information and construct the dictionary to return, as list.
* Regarding use of the CmdFrame fields see tclInt.h, and its definition.
@@ -1302,28 +1309,12 @@ TclInfoFrame(
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
- ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
- ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
- framePtr->cmd.str.len));
- break;
-
- case TCL_LOCATION_EVAL_LIST:
- /*
- * List optimized evaluation. Type, line, cmd, the latter through
- * listPtr, possibly a frame.
- */
-
- ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
- ADD_PAIR("line", Tcl_NewIntObj(1));
-
- /*
- * We put a duplicate of the command list obj into the result to
- * ensure that the 'pure List'-property of the command itself is not
- * destroyed. Otherwise the query here would disable the list
- * optimization path in Tcl_EvalObjEx.
- */
-
- ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
+ if (framePtr->line) {
+ ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ } else {
+ ADD_PAIR("line", Tcl_NewIntObj(1));
+ }
+ ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
break;
case TCL_LOCATION_PREBC:
@@ -1371,8 +1362,8 @@ TclInfoFrame(
Tcl_DecrRefCount(fPtr->data.eval.path);
}
- ADD_PAIR("cmd",
- Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
+ ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
+ needsFree = lc-1;
TclStackFree(interp, fPtr);
break;
}
@@ -1391,8 +1382,7 @@ TclInfoFrame(
* the result list object.
*/
- ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
- framePtr->cmd.str.len));
+ ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
break;
case TCL_LOCATION_PROC:
@@ -1461,7 +1451,11 @@ TclInfoFrame(
}
}
- return Tcl_NewListObj(lc, lv);
+ tmpObj = Tcl_NewListObj(lc, lv);
+ if (needsFree >= 0) {
+ Tcl_DecrRefCount(lv[needsFree]);
+ }
+ return tmpObj;
}
/*
@@ -2907,7 +2901,8 @@ Tcl_LsearchObjCmd(
{
const char *bytes, *patternBytes;
int i, match, index, result, listc, length, elemLen, bisect;
- int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+ int dataType, isIncreasing, lower, upper, offset;
+ Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
@@ -3005,7 +3000,7 @@ Tcl_LsearchObjCmd(
dataType = INTEGER;
break;
case LSEARCH_NOCASE: /* -nocase */
- strCmpFn = strcasecmp;
+ strCmpFn = TclUtfCasecmp;
noCase = 1;
break;
case LSEARCH_NOT: /* -not */
@@ -3226,7 +3221,7 @@ Tcl_LsearchObjCmd(
patternBytes = TclGetStringFromObj(patObj, &length);
break;
case INTEGER:
- result = TclGetIntFromObj(interp, patObj, &patInt);
+ result = TclGetWideIntFromObj(interp, patObj, &patWide);
if (result != TCL_OK) {
goto done;
}
@@ -3295,13 +3290,13 @@ Tcl_LsearchObjCmd(
match = DictionaryCompare(patternBytes, bytes);
break;
case INTEGER:
- result = TclGetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
if (result != TCL_OK) {
goto done;
}
- if (patInt == objInt) {
+ if (patWide == objWide) {
match = 0;
- } else if (patInt < objInt) {
+ } else if (patWide < objWide) {
match = -1;
} else {
match = 1;
@@ -3400,7 +3395,7 @@ Tcl_LsearchObjCmd(
*/
if (noCase) {
- match = (strcasecmp(bytes, patternBytes) == 0);
+ match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
@@ -3414,14 +3409,14 @@ Tcl_LsearchObjCmd(
break;
case INTEGER:
- result = TclGetIntFromObj(interp, itemPtr, &objInt);
+ result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
if (result != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
}
goto done;
}
- match = (objInt == patInt);
+ match = (objWide == patWide);
break;
case REAL:
@@ -3645,7 +3640,8 @@ Tcl_LsortObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
- int i, j, index, indices, length, nocase = 0, sortMode, indexc;
+ int i, j, index, indices, length, nocase = 0, indexc;
+ int sortMode = SORTMODE_ASCII;
int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
SortElement *elementArray, *elementPtr;
@@ -3984,14 +3980,14 @@ Tcl_LsortObjCmd(
if (sortMode == SORTMODE_ASCII) {
elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
} else if (sortMode == SORTMODE_INTEGER) {
- long a;
+ Tcl_WideInt a;
- if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
+ if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done1;
}
- elementArray[i].collationKey.intValue = a;
- } else if (sortInfo.sortMode == SORTMODE_REAL) {
+ elementArray[i].collationKey.wideValue = a;
+ } else if (sortMode == SORTMODE_REAL) {
double a;
if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
@@ -4088,7 +4084,7 @@ Tcl_LsortObjCmd(
TclStackFree(interp, elementArray);
done:
- if (sortInfo.sortMode == SORTMODE_COMMAND) {
+ if (sortMode == SORTMODE_COMMAND) {
TclDecrRefCount(sortInfo.compareCmdPtr);
TclDecrRefCount(listObj);
sortInfo.compareCmdPtr = NULL;
@@ -4233,16 +4229,16 @@ SortCompare(
order = strcmp(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
- order = strcasecmp(elemPtr1->collationKey.strValuePtr,
+ order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_INTEGER) {
- long a, b;
+ Tcl_WideInt a, b;
- a = elemPtr1->collationKey.intValue;
- b = elemPtr2->collationKey.intValue;
+ a = elemPtr1->collationKey.wideValue;
+ b = elemPtr2->collationKey.wideValue;
order = ((a >= b) - (a <= b));
} else if (infoPtr->sortMode == SORTMODE_REAL) {
double a, b;
generated by cgit v0.12 at 2025-06-02 14:59:45 (GMT)