summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c114
1 files changed, 46 insertions, 68 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 154c555..14d67f6 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -203,7 +203,7 @@ static const CmdInfo builtInCmds[] = {
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
-#ifndef TCL_NO_DEPRECATED
+#ifndef EXCLUDE_OBSOLETE_COMMANDS
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
@@ -510,11 +510,7 @@ Tcl_CreateInterp(void)
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
-#ifdef TCL_NO_DEPRECATED
- iPtr->result = &tclEmptyString;
-#else
iPtr->result = iPtr->resultSpace;
-#endif
iPtr->freeProc = NULL;
iPtr->errorLine = 0;
iPtr->objResultPtr = Tcl_NewObj();
@@ -574,26 +570,23 @@ Tcl_CreateInterp(void)
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
iPtr->lookupNsPtr = NULL;
-#ifndef TCL_NO_DEPRECATED
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
-#endif
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
/* TIP #268 */
-#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
iPtr->packagePrefer = PKG_PREFER_STABLE;
- } else
-#endif
+ } else {
iPtr->packagePrefer = PKG_PREFER_LATEST;
+ }
iPtr->cmdCount = 0;
TclInitLiteralTable(&iPtr->literalTable);
- iPtr->compileEpoch = 1;
+ iPtr->compileEpoch = 0;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
iPtr->evalFlags = 0;
@@ -608,9 +601,7 @@ Tcl_CreateInterp(void)
iPtr->emptyObjPtr = Tcl_NewObj();
/* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
-#ifndef TCL_NO_DEPRECATED
iPtr->resultSpace[0] = 0;
-#endif
iPtr->threadId = Tcl_GetCurrentThread();
/* TIP #378 */
@@ -948,8 +939,8 @@ Tcl_CreateInterp(void)
* Set up other variables such as tcl_version and tcl_library
*/
- Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
- Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
@@ -974,11 +965,11 @@ Tcl_CreateInterp(void)
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
if (TclTommath_Init(interp) != TCL_OK) {
- Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
if (TclOOInit(interp) != TCL_OK) {
- Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
/*
@@ -988,7 +979,7 @@ Tcl_CreateInterp(void)
#ifdef HAVE_ZLIB
if (TclZlibInit(interp) != TCL_OK) {
- Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
#endif
@@ -1071,7 +1062,7 @@ Tcl_CallWhenDeleted(
Interp *iPtr = (Interp *) interp;
static Tcl_ThreadDataKey assocDataCounterKey;
int *assocDataCounterPtr =
- Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
+ Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
int isNew;
char buffer[32 + TCL_INTEGER_SPACE];
AssocData *dPtr = ckalloc(sizeof(AssocData));
@@ -1543,12 +1534,10 @@ DeleteInterpProc(
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
-#ifndef TCL_NO_DEPRECATED
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
iPtr->appendResult = NULL;
}
-#endif
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
@@ -1646,7 +1635,7 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(iPtr->lineLAPtr);
- ckfree(iPtr->lineLAPtr);
+ ckfree((char *) iPtr->lineLAPtr);
iPtr->lineLAPtr = NULL;
if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
@@ -2414,7 +2403,7 @@ TclInvokeStringCommand(
TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
- argv[i] = TclGetString(objv[i]);
+ argv[i] = Tcl_GetString(objv[i]);
}
argv[objc] = 0;
@@ -2668,7 +2657,7 @@ TclRenameCommand(
}
Tcl_DStringAppend(&newFullName, newTail, -1);
cmdPtr->refCount++;
- CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName),
+ CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
Tcl_DStringFree(&newFullName);
@@ -3035,6 +3024,13 @@ Tcl_DeleteCommandFromToken(
Tcl_Command importCmd;
/*
+ * Bump the command epoch counter. This will invalidate all cached
+ * references that point to this command.
+ */
+
+ cmdPtr->cmdEpoch++;
+
+ /*
* The code here is tricky. We can't delete the hash table entry before
* invoking the deletion callback because there are cases where the
* deletion callback needs to invoke the command (e.g. object systems such
@@ -3056,14 +3052,6 @@ Tcl_DeleteCommandFromToken(
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
}
-
- /*
- * Bump the command epoch counter. This will invalidate all cached
- * references that point to this command.
- */
-
- cmdPtr->cmdEpoch++;
-
return 0;
}
@@ -3166,13 +3154,6 @@ Tcl_DeleteCommandFromToken(
if (cmdPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
-
- /*
- * Bump the command epoch counter. This will invalidate all cached
- * references that point to this command.
- */
-
- cmdPtr->cmdEpoch++;
}
/*
@@ -3419,7 +3400,8 @@ TclCleanupCommand(
register Command *cmdPtr) /* Points to the Command structure to
* be freed. */
{
- if (cmdPtr->refCount-- <= 1) {
+ cmdPtr->refCount--;
+ if (cmdPtr->refCount <= 0) {
ckfree(cmdPtr);
}
}
@@ -3541,7 +3523,7 @@ OldMathFuncProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
- TclCheckBadOctal(interp, TclGetString(valuePtr));
+ TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
ckfree(args);
return TCL_ERROR;
}
@@ -3561,7 +3543,7 @@ OldMathFuncProc(
args[k].type = TCL_INT;
break;
}
- if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
+ if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
== TCL_OK) {
args[k].type = TCL_WIDE_INT;
break;
@@ -3587,7 +3569,7 @@ OldMathFuncProc(
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
- Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
+ TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
Tcl_ResetResult(interp);
break;
}
@@ -3961,7 +3943,7 @@ Tcl_Canceled(
*/
if (iPtr->asyncCancelMsg != NULL) {
- message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
+ message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
} else {
length = 0;
}
@@ -4060,7 +4042,7 @@ Tcl_CancelEval(
*/
if (resultObjPtr != NULL) {
- result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
+ result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
TclDecrRefCount(resultObjPtr); /* Discard their result object. */
@@ -4572,7 +4554,7 @@ TEOV_Error(
*/
listPtr = Tcl_NewListObj(objc, objv);
- cmdString = TclGetStringFromObj(listPtr, &cmdLen);
+ cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(listPtr);
}
@@ -4716,9 +4698,9 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
- size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
int length, traceCode = TCL_OK;
- const char *command = TclGetStringFromObj(commandPtr, &length);
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
/*
* Call trace functions.
@@ -4770,7 +4752,7 @@ TEOV_RunLeaveTraces(
Command *cmdPtr = data[2];
Tcl_Obj **objv = data[3];
int length;
- const char *command = TclGetStringFromObj(commandPtr, &length);
+ const char *command = Tcl_GetStringFromObj(commandPtr, &length);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
@@ -5596,7 +5578,8 @@ TclArgumentRelease(
}
cfwPtr = Tcl_GetHashValue(hPtr);
- if (cfwPtr->refCount-- > 1) {
+ cfwPtr->refCount--;
+ if (cfwPtr->refCount > 0) {
continue;
}
@@ -5861,7 +5844,6 @@ TclArgumentGet(
*----------------------------------------------------------------------
*/
-#ifndef TCL_NO_DEPRECATED
#undef Tcl_Eval
int
Tcl_Eval(
@@ -5914,7 +5896,6 @@ Tcl_GlobalEvalObj(
{
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}
-#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6068,7 +6049,7 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
objPtr, NULL);
- TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ ListObjGetElements(listPtr, objc, objv);
return TclNREvalObjv(interp, objc, objv, flags, NULL);
}
@@ -6136,7 +6117,7 @@ TclNREvalObjEx(
Tcl_IncrRefCount(objPtr);
- script = TclGetStringFromObj(objPtr, &numSrcBytes);
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
TclDecrRefCount(objPtr);
@@ -6167,7 +6148,7 @@ TEOEx_ByteCodeCallback(
ProcessUnexpectedResult(interp, result);
result = TCL_ERROR;
- script = TclGetStringFromObj(objPtr, &numSrcBytes);
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
}
@@ -6715,10 +6696,11 @@ Tcl_AppendObjToErrorInfo(
* pertains. */
Tcl_Obj *objPtr) /* Message to record. */
{
- const char *message = TclGetString(objPtr);
+ int length;
+ const char *message = TclGetStringFromObj(objPtr, &length);
Tcl_IncrRefCount(objPtr);
- Tcl_AddObjErrorInfo(interp, message, objPtr->length);
+ Tcl_AddObjErrorInfo(interp, message, length);
Tcl_DecrRefCount(objPtr);
}
@@ -6741,7 +6723,6 @@ Tcl_AppendObjToErrorInfo(
*----------------------------------------------------------------------
*/
-#ifndef TCL_NO_DEPRECATED
#undef Tcl_AddErrorInfo
void
Tcl_AddErrorInfo(
@@ -6751,7 +6732,6 @@ Tcl_AddErrorInfo(
{
Tcl_AddObjErrorInfo(interp, message, -1);
}
-#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6867,7 +6847,7 @@ Tcl_VarEvalVA(
Tcl_DStringAppend(&buf, string, -1);
}
- result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
Tcl_DStringFree(&buf);
return result;
}
@@ -6924,7 +6904,6 @@ Tcl_VarEval(
*----------------------------------------------------------------------
*/
-#ifndef TCL_NO_DEPRECATED
#undef Tcl_GlobalEval
int
Tcl_GlobalEval(
@@ -6938,11 +6917,10 @@ Tcl_GlobalEval(
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = iPtr->rootFramePtr;
- result = Tcl_EvalEx(interp, command, -1, 0);
+ result = Tcl_Eval(interp, command);
iPtr->varFramePtr = savedVarFramePtr;
return result;
}
-#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -7196,7 +7174,7 @@ ExprIsqrtFunc(
}
break;
default:
- if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
+ if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
return TCL_ERROR;
}
if (w < 0) {
@@ -7639,7 +7617,7 @@ ExprWideFunc(
return TCL_ERROR;
}
objPtr = Tcl_GetObjResult(interp);
- if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
+ if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
/*
* Truncate the bignum; keep only bits in wide int range.
*/
@@ -7650,7 +7628,7 @@ ExprWideFunc(
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
- Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
+ TclGetWideIntFromObj(NULL, objPtr, &wResult);
Tcl_DecrRefCount(objPtr);
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
@@ -7906,7 +7884,7 @@ MathFuncWrongNumArgs(
int found, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
- const char *name = TclGetString(objv[0]);
+ const char *name = Tcl_GetString(objv[0]);
const char *tail = name + strlen(name);
while (tail > name+1) {
@@ -8869,7 +8847,7 @@ TclNRInterpCoroutine(
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"coroutine \"%s\" is already running",
- TclGetString(objv[0])));
+ Tcl_GetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-08-19 21:01:03 (GMT)