diff options
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 86 |
1 files changed, 46 insertions, 40 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4bddbce..32caac5 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 EXCLUDE_OBSOLETE_COMMANDS +#ifndef TCL_NO_DEPRECATED {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, @@ -578,15 +578,16 @@ Tcl_CreateInterp(void) 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 { + } else +#endif iPtr->packagePrefer = PKG_PREFER_LATEST; - } iPtr->cmdCount = 0; TclInitLiteralTable(&iPtr->literalTable); - iPtr->compileEpoch = 0; + iPtr->compileEpoch = 1; iPtr->compiledProcPtr = NULL; iPtr->resolverPtr = NULL; iPtr->evalFlags = 0; @@ -939,8 +940,8 @@ Tcl_CreateInterp(void) * Set up other variables such as tcl_version and tcl_library */ - Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_version", NULL, 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); @@ -965,11 +966,11 @@ Tcl_CreateInterp(void) Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); if (TclTommath_Init(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } if (TclOOInit(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } /* @@ -979,7 +980,7 @@ Tcl_CreateInterp(void) #ifdef HAVE_ZLIB if (TclZlibInit(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } #endif @@ -1635,7 +1636,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree((char *) iPtr->lineLAPtr); + ckfree(iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { @@ -2403,7 +2404,7 @@ TclInvokeStringCommand( TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { - argv[i] = Tcl_GetString(objv[i]); + argv[i] = TclGetString(objv[i]); } argv[objc] = 0; @@ -2657,7 +2658,7 @@ TclRenameCommand( } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; - CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName), + CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); Tcl_DStringFree(&newFullName); @@ -3024,13 +3025,6 @@ 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 @@ -3052,6 +3046,14 @@ 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; } @@ -3154,6 +3156,13 @@ 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++; } /* @@ -3400,8 +3409,7 @@ TclCleanupCommand( register Command *cmdPtr) /* Points to the Command structure to * be freed. */ { - cmdPtr->refCount--; - if (cmdPtr->refCount <= 0) { + if (cmdPtr->refCount-- <= 1) { ckfree(cmdPtr); } } @@ -3523,7 +3531,7 @@ OldMathFuncProc( Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", -1)); - TclCheckBadOctal(interp, Tcl_GetString(valuePtr)); + TclCheckBadOctal(interp, TclGetString(valuePtr)); ckfree(args); return TCL_ERROR; } @@ -3943,7 +3951,7 @@ Tcl_Canceled( */ if (iPtr->asyncCancelMsg != NULL) { - message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length); + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); } else { length = 0; } @@ -4042,7 +4050,7 @@ Tcl_CancelEval( */ if (resultObjPtr != NULL) { - result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length); + result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, (size_t) cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ @@ -4554,7 +4562,7 @@ TEOV_Error( */ listPtr = Tcl_NewListObj(objc, objv); - cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen); + cmdString = TclGetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(listPtr); } @@ -4698,9 +4706,9 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int length, traceCode = TCL_OK; - const char *command = Tcl_GetStringFromObj(commandPtr, &length); + const char *command = TclGetStringFromObj(commandPtr, &length); /* * Call trace functions. @@ -4752,7 +4760,7 @@ TEOV_RunLeaveTraces( Command *cmdPtr = data[2]; Tcl_Obj **objv = data[3]; int length; - const char *command = Tcl_GetStringFromObj(commandPtr, &length); + const char *command = TclGetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){ @@ -5578,8 +5586,7 @@ TclArgumentRelease( } cfwPtr = Tcl_GetHashValue(hPtr); - cfwPtr->refCount--; - if (cfwPtr->refCount > 0) { + if (cfwPtr->refCount-- > 1) { continue; } @@ -6049,7 +6056,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); - ListObjGetElements(listPtr, objc, objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } @@ -6117,7 +6124,7 @@ TclNREvalObjEx( Tcl_IncrRefCount(objPtr); - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + script = TclGetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); @@ -6148,7 +6155,7 @@ TEOEx_ByteCodeCallback( ProcessUnexpectedResult(interp, result); result = TCL_ERROR; - script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); + script = TclGetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } @@ -6696,11 +6703,10 @@ Tcl_AppendObjToErrorInfo( * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - int length; - const char *message = TclGetStringFromObj(objPtr, &length); + const char *message = TclGetString(objPtr); Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, length); + Tcl_AddObjErrorInfo(interp, message, objPtr->length); Tcl_DecrRefCount(objPtr); } @@ -6847,7 +6853,7 @@ Tcl_VarEvalVA( Tcl_DStringAppend(&buf, string, -1); } - result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); Tcl_DStringFree(&buf); return result; } @@ -6917,7 +6923,7 @@ Tcl_GlobalEval( savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_Eval(interp, command); + result = Tcl_EvalEx(interp, command, -1, 0); iPtr->varFramePtr = savedVarFramePtr; return result; } @@ -7884,7 +7890,7 @@ MathFuncWrongNumArgs( int found, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Actual parameter vector. */ { - const char *name = Tcl_GetString(objv[0]); + const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); while (tail > name+1) { @@ -8817,7 +8823,7 @@ TclNRInterpCoroutine( if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "coroutine \"%s\" is already running", - Tcl_GetString(objv[0]))); + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL); return TCL_ERROR; } |