diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-07-04 07:09:40 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-07-04 07:09:40 (GMT) |
commit | 9dee089fa2567d307056363c20eb69c53b4e1655 (patch) | |
tree | f601a0cf95af6e9aeea8f330063f37565515f418 /generic | |
parent | 6de91b6b7d469c5f8d511700b75689df23e43fd1 (diff) | |
parent | d3104ac52bdca1849c62445954323c841fcd5009 (diff) | |
download | tcl-9dee089fa2567d307056363c20eb69c53b4e1655.zip tcl-9dee089fa2567d307056363c20eb69c53b4e1655.tar.gz tcl-9dee089fa2567d307056363c20eb69c53b4e1655.tar.bz2 |
merge trunk
Diffstat (limited to 'generic')
32 files changed, 333 insertions, 251 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 02144a1..83f4fe9 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -265,7 +265,7 @@ static int CheckStrictlyPositive(Tcl_Interp*, int); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, - TalInstDesc*); + const TalInstDesc*); static int DefineLabel(AssemblyEnv* envPtr, const char* label); static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void DupAssembleCodeInternalRep(Tcl_Obj* src, @@ -350,7 +350,7 @@ static const Tcl_ObjType assembleCodeType = { * Source instructions recognized in the Tcl Assembly Language (TAL) */ -TalInstDesc TalInstructionTable[] = { +static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ {"push", ASSEM_PUSH, (INST_PUSH1<<8 | INST_PUSH4), 0, 1}, @@ -1768,7 +1768,7 @@ static void CompileEmbeddedScript( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */ - TalInstDesc* instPtr) /* Instruction that determines whether + const TalInstDesc* instPtr) /* Instruction that determines whether * the script is 'expr' or 'eval' */ { CompileEnv* envPtr = assemEnvPtr->envPtr; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0b02d0d..537750e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -134,6 +134,8 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, static Tcl_NRPostProc NRCoroutineActivateCallback; static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; +static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); + static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc NRTailcallEval; static Tcl_ObjCmdProc OldMathFuncProc; @@ -2610,7 +2612,7 @@ TclRenameCommand( Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { - Tcl_DStringAppend(&newFullName, "::", 2); + TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; @@ -3468,7 +3470,7 @@ Tcl_CreateMathFunc( data->clientData = clientData; Tcl_DStringInit(&bigName); - Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1); + TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); Tcl_DStringAppend(&bigName, name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), @@ -4363,7 +4365,7 @@ TclNRRunCallbacks( return result; } -int +static int NRCommand( ClientData data[], Tcl_Interp *interp, @@ -8593,7 +8595,7 @@ RewindCoroutine( corPtr->eePtr->rewind = 1; TclNRAddCallback(interp, RewindCoroutineCallback, state, NULL, NULL, NULL); - return NRInterpCoroutine(corPtr, interp, 0, NULL); + return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void @@ -8820,7 +8822,7 @@ NRCoroInjectObjCmd( } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); - if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) { + if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_AppendResult(interp, "can only inject a command into a coroutine", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", @@ -8849,7 +8851,7 @@ NRCoroInjectObjCmd( } int -NRInterpCoroutine( +TclNRInterpCoroutine( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -8971,12 +8973,12 @@ TclNRCoroutineObjCmd( Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), - /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine); + /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); Tcl_DStringFree(&ds); corPtr->cmdPtr = cmdPtr; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 4292224..f09ee70 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -629,24 +629,26 @@ EncodingDirsObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tcl_Obj *dirListObj; + if (objc > 3) { - Tcl_WrongNumArgs(interp, 1, objv, "?dirList?"); + Tcl_WrongNumArgs(interp, 2, objv, "?dirList?"); return TCL_ERROR; } - objc -= 1; - objv += 1; - if (objc == 1) { + if (objc == 2) { Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); return TCL_OK; } - if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) { + + dirListObj = objv[2]; + if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) { Tcl_AppendResult(interp, "expected directory list but got \"", - TclGetString(objv[1]), "\"", NULL); + TclGetString(dirListObj), "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH", NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, objv[1]); + Tcl_SetObjResult(interp, dirListObj); return TCL_OK; } @@ -1043,9 +1045,9 @@ TclMakeFileCommandSafe( Tcl_DString oldBuf, newBuf; Tcl_DStringInit(&oldBuf); - Tcl_DStringAppend(&oldBuf, "::tcl::file::", -1); + TclDStringAppendLiteral(&oldBuf, "::tcl::file::"); Tcl_DStringInit(&newBuf); - Tcl_DStringAppend(&newBuf, "tcl:file:", -1); + TclDStringAppendLiteral(&newBuf, "tcl:file:"); for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { if (unsafeInfo[i].unsafe) { const char *oldName, *newName; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 5b7e0a5..3540716 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -820,7 +820,7 @@ TclCompileDictForCmd( */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size); + TclDStringAppendToken(&buffer, &varsTokenPtr[1]); if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, &argv) != TCL_OK) { Tcl_DStringFree(&buffer); @@ -1961,7 +1961,7 @@ TclCompileForeachCmd( */ Tcl_DStringInit(&varList); - Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size); + TclDStringAppendToken(&varList, &tokenPtr[1]); code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b950e21..8ed3a95 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1558,8 +1558,7 @@ IssueSwitchJumpTable( */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, bodyToken[i]->start, - bodyToken[i]->size); + TclDStringAppendToken(&buffer, bodyToken[i]); hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, Tcl_DStringValue(&buffer), &isNew); if (isNew) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 4212b6d..890d518 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2296,7 +2296,7 @@ CompileExprTree( int length; Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1); + TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = TclGetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1d88e11..d4ca284 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1661,8 +1661,8 @@ TclCompileScript( * have side effects that rely on the unmodified string. */ - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size); + TclDStringClear(&ds); + TclDStringAppendToken(&ds, &tokenPtr[1]); cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), @@ -2044,7 +2044,7 @@ TclCompileTokens( for ( ; count > 0; count--, tokenPtr++) { switch (tokenPtr->type) { case TCL_TOKEN_TEXT: - Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size); + TclDStringAppendToken(&textBuffer, tokenPtr); TclAdvanceLines(&envPtr->line, tokenPtr->start, tokenPtr->start + tokenPtr->size); break; @@ -2091,9 +2091,7 @@ TclCompileTokens( */ if (Tcl_DStringLength(&textBuffer) > 0) { - int literal = TclRegisterNewLiteral(envPtr, - Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); + int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; @@ -2120,9 +2118,7 @@ TclCompileTokens( if (Tcl_DStringLength(&textBuffer) > 0) { int literal; - literal = TclRegisterNewLiteral(envPtr, - Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); + literal = TclRegisterDStringLiteral(envPtr, &textBuffer); TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); @@ -2145,13 +2141,10 @@ TclCompileTokens( */ if (Tcl_DStringLength(&textBuffer) > 0) { - int literal; + int literal = TclRegisterDStringLiteral(envPtr, &textBuffer); - literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer), - Tcl_DStringLength(&textBuffer)); TclEmitPush(literal, envPtr); numObjsToConcat++; - if (numCL) { TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, numCL, clPosition); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 58663fd..ba78c36 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -866,8 +866,7 @@ typedef struct { *---------------------------------------------------------------- */ -MODULE_SCOPE Tcl_NRPostProc NRCommand; -MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine; +MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* *---------------------------------------------------------------- @@ -1365,6 +1364,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) /* + * Macros for making it easier to deal with tokens and DStrings. + */ + +#define TclDStringAppendToken(dsPtr, tokenPtr) \ + Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size) +#define TclRegisterDStringLiteral(envPtr, dsPtr) \ + TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \ + Tcl_DStringLength(dsPtr), /*flags*/ 0) + +/* * DTrace probe macros (NOPs if DTrace support is not enabled). */ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index b4735e8..dea487a 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -155,7 +155,7 @@ Tcl_RegisterConfig( */ Tcl_DStringInit(&cmdName); - Tcl_DStringAppend(&cmdName, "::", -1); + TclDStringAppendLiteral(&cmdName, "::"); Tcl_DStringAppend(&cmdName, pkgName, -1); /* @@ -173,7 +173,7 @@ Tcl_RegisterConfig( } } - Tcl_DStringAppend(&cmdName, "::pkgconfig", -1); + TclDStringAppendLiteral(&cmdName, "::pkgconfig"); if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) { diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 49418c9..0fa6661 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1872,9 +1872,9 @@ LoadTableEncoding( * Read lines from the encoding until EOF. */ - for (Tcl_DStringSetLength(&lineString, 0); + for (TclDStringClear(&lineString); (len = Tcl_Gets(chan, &lineString)) >= 0; - Tcl_DStringSetLength(&lineString, 0)) { + TclDStringClear(&lineString)) { const unsigned char *p; int to, from; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 1e1a901..754e480 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1425,9 +1425,9 @@ TclMakeEnsemble( Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); - Tcl_DStringAppend(&hiddenBuf, "tcl:", -1); + TclDStringAppendLiteral(&hiddenBuf, "tcl:"); Tcl_DStringAppend(&hiddenBuf, name, -1); - Tcl_DStringAppend(&hiddenBuf, ":", -1); + TclDStringAppendLiteral(&hiddenBuf, ":"); hiddenLen = Tcl_DStringLength(&hiddenBuf); if (name[0] == ':' && name[1] == ':') { /* @@ -1443,14 +1443,14 @@ TclMakeEnsemble( * multi-word list differently to a single word. */ - Tcl_DStringAppend(&buf, "::tcl", -1); + TclDStringAppendLiteral(&buf, "::tcl"); if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) { Tcl_Panic("invalid ensemble name '%s'", name); } for (i = 0; i < nameCount; ++i) { - Tcl_DStringAppend(&buf, "::", 2); + TclDStringAppendLiteral(&buf, "::"); Tcl_DStringAppend(&buf, nameParts[i], -1); } } @@ -1485,7 +1485,7 @@ TclMakeEnsemble( Tcl_Obj *mapDict, *fromObj, *toObj; Command *cmdPtr; - Tcl_DStringAppend(&buf, "::", 2); + TclDStringAppendLiteral(&buf, "::"); TclNewObj(mapDict); for (i=0 ; map[i].name != NULL ; i++) { fromObj = Tcl_NewStringObj(map[i].name, -1); @@ -1615,10 +1615,10 @@ NsEnsembleImplementationCmdNR( Tcl_Panic("List of ensemble parameters is not a list"); } for (; len>0; len--,elemPtrs++) { - Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1); - Tcl_DStringAppend(&buf, " ", -1); + TclDStringAppendObj(&buf, *elemPtrs); + TclDStringAppendLiteral(&buf, " "); } - Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1); + TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf)); Tcl_DStringFree(&buf); diff --git a/generic/tclEnv.c b/generic/tclEnv.c index e45ae6a..b5ae6ea 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -772,9 +772,9 @@ TclCygwinPutenv( } else { int size; - size = cygwin_posix_to_win32_path_list_buf_size(value); + size = cygwin_conv_path_list(0, value, NULL, 0); buf = alloca(size + 1); - cygwin_posix_to_win32_path_list(value, buf); + cygwin_conv_path_list(0, value, buf, size); } SetEnvironmentVariableA(name, buf); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 48c5454..edb6581 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -72,9 +72,9 @@ SetResultLength( { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { - Tcl_DStringAppend(resultPtr, "//?/UNC/", 8); + TclDStringAppendLiteral(resultPtr, "//?/UNC/"); } else if (extended == 1) { - Tcl_DStringAppend(resultPtr, "//?/", 4); + TclDStringAppendLiteral(resultPtr, "//?/"); } } @@ -131,7 +131,7 @@ ExtractWinRoot( if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[1]; } host = &path[2]; @@ -161,7 +161,7 @@ ExtractWinRoot( */ *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[2]; } SetResultLength(resultPtr, offset, extended); @@ -180,9 +180,9 @@ ExtractWinRoot( break; } } - Tcl_DStringAppend(resultPtr, "//", 2); + TclDStringAppendLiteral(resultPtr, "//"); Tcl_DStringAppend(resultPtr, host, hlen); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; @@ -221,7 +221,7 @@ ExtractWinRoot( *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return tail; } @@ -1057,7 +1057,7 @@ Tcl_TranslateFileName( } Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); + TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); @@ -1413,7 +1413,7 @@ Tcl_GlobObjCmd( search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); - Tcl_DStringAppend(&prefix, "\\", 1); + TclDStringAppendLiteral(&prefix, "\\"); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { @@ -1575,8 +1575,7 @@ Tcl_GlobObjCmd( Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&prefix, string, length); + TclDStringAppendObj(&prefix, objv[i]); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } @@ -1592,11 +1591,9 @@ Tcl_GlobObjCmd( for (i = 0; i < objc; i++) { Tcl_DStringInit(&str); if (dir == PATH_GENERAL) { - Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix), - Tcl_DStringLength(&prefix)); + TclDStringAppendDString(&str, &prefix); } - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&str, string, length); + TclDStringAppendObj(&str, objv[i]); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; @@ -2401,9 +2398,9 @@ DoGlob( if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } @@ -2412,9 +2409,9 @@ DoGlob( case TCL_PLATFORM_UNIX: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } break; diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 088bf85..6be3e03 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -16,44 +16,6 @@ #include "tcl.h" /* - * struct FilesystemRecord -- - * - * A filesystem record is used to keep track of each filesystem currently - * registered with the core, in a linked list. Pointers to these structures - * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the - * number of such references. - */ - -typedef struct FilesystemRecord { - ClientData clientData; /* Client specific data for the new filesystem - * (can be NULL) */ - const Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch table. */ - struct FilesystemRecord *nextPtr; - /* The next filesystem registered to Tcl, or - * NULL if no more. */ - struct FilesystemRecord *prevPtr; - /* The previous filesystem registered to Tcl, - * or NULL if no more. */ -} FilesystemRecord; - -/* - * This structure holds per-thread private copy of the current directory - * maintained by the global cwdPathPtr. This structure holds per-thread - * private copies of some global data. This way we avoid most of the - * synchronization calls which boosts performance, at cost of having to update - * this information each time the corresponding epoch counter changes. - */ - -typedef struct ThreadSpecificData { - int initialized; - int cwdPathEpoch; - int filesystemEpoch; - Tcl_Obj *cwdPathPtr; - ClientData cwdClientData; - FilesystemRecord *filesystemList; -} ThreadSpecificData; - -/* * The internal TclFS API provides routines for handling and manipulating * paths efficiently, taking direct advantage of the "path" Tcl_Obj type. * @@ -61,8 +23,6 @@ typedef struct ThreadSpecificData { */ MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr); -MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp, - Tcl_Obj *pathPtr); MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt); MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, @@ -73,13 +33,13 @@ MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); +MODULE_SCOPE int TclFSEpoch(void); /* * Private shared variables for use by tclIOUtil.c and tclPathObj.c */ MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem; -MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey; /* * Private shared functions for use by tclIOUtil.c, tclPathObj.c and diff --git a/generic/tclIO.c b/generic/tclIO.c index a76aba3..ea6c2d7 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4431,14 +4431,12 @@ Tcl_Gets( * for managing the storage. */ { Tcl_Obj *objPtr; - int charsStored, length; - const char *string; + int charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); if (charsStored > 0) { - string = TclGetStringFromObj(objPtr, &length); - Tcl_DStringAppend(lineRead, string, length); + TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); return charsStored; @@ -7550,7 +7548,7 @@ Tcl_BadChannelOption( Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { - Tcl_DStringAppend(&ds, " ", 1); + TclDStringAppendLiteral(&ds, " "); Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 938def2..6fec40a 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -1947,7 +1947,7 @@ ReflectGetOption( */ if (optionObj != NULL) { - Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1); + TclDStringAppendObj(dsPtr, resObj); goto ok; } @@ -1982,7 +1982,7 @@ ReflectGetOption( const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(dsPtr, " ", 1); + TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; @@ -3207,8 +3207,7 @@ ForwardProc( if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { - Tcl_DStringAppend(paramPtr->getOpt.value, - TclGetString(resObj), -1); + TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); @@ -3233,7 +3232,7 @@ ForwardProc( Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { + &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); @@ -3253,7 +3252,7 @@ ForwardProc( const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1); + TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 6a7be7e..018f9f5 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -100,16 +100,16 @@ TclSockMinimumBuffers( socklen_t len; len = sizeof(int); - getsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)¤t, &len); + getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)¤t, &len); if (current < size) { len = sizeof(int); - setsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len); + setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len); } len = sizeof(int); - getsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)¤t, &len); + getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)¤t, &len); if (current < size) { len = sizeof(int); - setsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len); + setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len); } return TCL_OK; } @@ -206,9 +206,12 @@ TclCreateSocketAddress( } if (result != 0) { - if (result != EAI_SYSTEM) { +#ifdef EAI_SYSTEM /* Doesn't exist on Windows */ + if (result == EAI_SYSTEM) + *errorMsgPtr = Tcl_PosixError(interp); + else +#endif *errorMsgPtr = gai_strerror(result); - } return 0; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index b8bb0f7..41a5aac 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -28,6 +28,43 @@ #include "tclFileSystem.h" /* + * struct FilesystemRecord -- + * + * A filesystem record is used to keep track of each filesystem currently + * registered with the core, in a linked list. + */ + +typedef struct FilesystemRecord { + ClientData clientData; /* Client specific data for the new filesystem + * (can be NULL) */ + const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ + struct FilesystemRecord *nextPtr; + /* The next filesystem registered to Tcl, or + * NULL if no more. */ + struct FilesystemRecord *prevPtr; + /* The previous filesystem registered to Tcl, + * or NULL if no more. */ +} FilesystemRecord; + +/* + * This structure holds per-thread private copy of the current directory + * maintained by the global cwdPathPtr. This structure holds per-thread + * private copies of some global data. This way we avoid most of the + * synchronization calls which boosts performance, at cost of having to update + * this information each time the corresponding epoch counter changes. + */ + +typedef struct ThreadSpecificData { + int initialized; + int cwdPathEpoch; + int filesystemEpoch; + Tcl_Obj *cwdPathPtr; + ClientData cwdClientData; + FilesystemRecord *filesystemList; + int claims; +} ThreadSpecificData; + +/* * Prototypes for functions defined later in this file. */ @@ -40,9 +77,10 @@ static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData); -#ifdef TCL_THREADS static void FsRecacheFilesystemList(void); -#endif +static void Claim(void); +static void Disclaim(void); + static void * DivertFindSymbol(Tcl_Interp *interp, Tcl_LoadHandle loadHandle, const char *symbol); static void DivertUnloadFile(Tcl_LoadHandle loadHandle); @@ -174,7 +212,7 @@ static FilesystemRecord nativeFilesystemRecord = { * trigger cache cleanup in all threads. */ -static int theFilesystemEpoch = 0; +static int theFilesystemEpoch = 1; /* * Stores the linked list of filesystems. A 1:1 copy of this list is also @@ -194,7 +232,7 @@ static int cwdPathEpoch = 0; static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) -Tcl_ThreadDataKey tclFsDataKey; +static Tcl_ThreadDataKey fsDataKey; /* * One of these structures is used each time we successfully load a file from @@ -367,7 +405,7 @@ Tcl_GetCwd( return NULL; } Tcl_DStringInit(cwdPtr); - Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1); + TclDStringAppendObj(cwdPtr, cwd); Tcl_DecrRefCount(cwd); return Tcl_DStringValue(cwdPtr); } @@ -428,7 +466,7 @@ FsThrExitProc( int TclFSCwdIsNative(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (tsdPtr->cwdClientData != NULL) { return 1; @@ -462,7 +500,7 @@ int TclFSCwdPointerEquals( Tcl_Obj **pathPtrPtr) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); Tcl_MutexLock(&cwdMutex); if (tsdPtr->cwdPathPtr == NULL @@ -521,12 +559,11 @@ TclFSCwdPointerEquals( } } -#ifdef TCL_THREADS static void FsRecacheFilesystemList(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list; /* * Trash the current cache. @@ -535,20 +572,16 @@ FsRecacheFilesystemList(void) fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; - fsRecPtr->fsPtr = NULL; fsRecPtr->nextPtr = toFree; toFree = fsRecPtr; fsRecPtr = tmpFsRecPtr; } - tsdPtr->filesystemList = NULL; /* - * Code below operates on shared data. We are already called under mutex - * lock so we can safely proceed. - * * Locate tail of the global filesystem list. */ + Tcl_MutexLock(&filesystemMutex); fsRecPtr = filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr; @@ -559,21 +592,23 @@ FsRecacheFilesystemList(void) * Refill the cache honouring the order. */ + list = NULL; fsRecPtr = tmpFsRecPtr; while (fsRecPtr != NULL) { tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord)); *tmpFsRecPtr = *fsRecPtr; - tmpFsRecPtr->nextPtr = tsdPtr->filesystemList; + tmpFsRecPtr->nextPtr = list; tmpFsRecPtr->prevPtr = NULL; - if (tsdPtr->filesystemList) { - tsdPtr->filesystemList->prevPtr = tmpFsRecPtr; - } - tsdPtr->filesystemList = tmpFsRecPtr; + list = tmpFsRecPtr; fsRecPtr = fsRecPtr->prevPtr; } + tsdPtr->filesystemList = list; + tsdPtr->filesystemEpoch = theFilesystemEpoch; + Tcl_MutexUnlock(&filesystemMutex); while (toFree) { FilesystemRecord *next = toFree->nextPtr; + toFree->fsPtr = NULL; ckfree(toFree); toFree = next; } @@ -587,28 +622,16 @@ FsRecacheFilesystemList(void) tsdPtr->initialized = 1; } } -#endif /* TCL_THREADS */ static FilesystemRecord * FsGetFirstFilesystem(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - FilesystemRecord *fsRecPtr; - -#ifndef TCL_THREADS - tsdPtr->filesystemEpoch = theFilesystemEpoch; - fsRecPtr = filesystemList; -#else - Tcl_MutexLock(&filesystemMutex); - if (tsdPtr->filesystemList == NULL - || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0) + && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) { FsRecacheFilesystemList(); - tsdPtr->filesystemEpoch = theFilesystemEpoch; } - Tcl_MutexUnlock(&filesystemMutex); - fsRecPtr = tsdPtr->filesystemList; -#endif - return fsRecPtr; + return tsdPtr->filesystemList; } /* @@ -620,11 +643,30 @@ int TclFSEpochOk( int filesystemEpoch) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch); +} + +static void +Claim() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + tsdPtr->claims++; +} + +static void +Disclaim() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + tsdPtr->claims--; +} - (void) FsGetFirstFilesystem(); - return (filesystemEpoch == tsdPtr->filesystemEpoch); +int +TclFSEpoch() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + return tsdPtr->filesystemEpoch; } + /* * If non-NULL, clientData is owned by us and must be freed later. @@ -637,7 +679,7 @@ FsUpdateCwd( { int len; const char *str = NULL; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { str = Tcl_GetStringFromObj(cwdObj, &len); @@ -741,6 +783,7 @@ TclFinalizeFilesystem(void) } fsRecPtr = tmpFsRecPtr; } + theFilesystemEpoch++; filesystemList = NULL; /* @@ -773,6 +816,7 @@ void TclResetFilesystem(void) { filesystemList = &nativeFilesystemRecord; + theFilesystemEpoch++; #ifdef __WIN32__ /* @@ -1345,6 +1389,7 @@ TclFSNormalizeToUniquePath( firstFsRecPtr = FsGetFirstFilesystem(); + Claim(); for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; @@ -1382,6 +1427,7 @@ TclFSNormalizeToUniquePath( * but there's not much benefit. */ } + Disclaim(); return startAt; } @@ -2576,7 +2622,7 @@ Tcl_Obj * Tcl_FSGetCwd( Tcl_Interp *interp) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (TclFSCwdPointerEquals(NULL)) { FilesystemRecord *fsRecPtr; @@ -2588,8 +2634,9 @@ Tcl_FSGetCwd( * indicates the particular function has succeeded. */ - for (fsRecPtr = FsGetFirstFilesystem(); - (retVal == NULL) && (fsRecPtr != NULL); + fsRecPtr = FsGetFirstFilesystem(); + Claim(); + for (; (retVal == NULL) && (fsRecPtr != NULL); fsRecPtr = fsRecPtr->nextPtr) { ClientData retCd; TclFSGetCwdProc2 *proc2; @@ -2634,6 +2681,7 @@ Tcl_FSGetCwd( } Tcl_DecrRefCount(retVal); retVal = NULL; + Disclaim(); goto cdDidNotChange; } else if (interp != NULL) { Tcl_AppendResult(interp, @@ -2641,6 +2689,7 @@ Tcl_FSGetCwd( Tcl_PosixError(interp), NULL); } } + Disclaim(); /* * Now the 'cwd' may NOT be normalized, at least on some platforms. @@ -2924,7 +2973,7 @@ Tcl_FSChdir( * instead. This should be examined by someone on Unix. */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); ClientData cd; ClientData oldcd = tsdPtr->cwdClientData; @@ -3761,6 +3810,7 @@ Tcl_FSListVolumes(void) */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr->listVolumesProc != NULL) { Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); @@ -3772,6 +3822,7 @@ Tcl_FSListVolumes(void) } fsRecPtr = fsRecPtr->nextPtr; } + Disclaim(); return resultPtr; } @@ -3811,6 +3862,7 @@ FsListMounts( */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr != &tclNativeFilesystem && fsRecPtr->fsPtr->matchInDirectoryProc != NULL) { @@ -3822,6 +3874,7 @@ FsListMounts( } fsRecPtr = fsRecPtr->nextPtr; } + Disclaim(); return resultPtr; } @@ -4034,6 +4087,7 @@ TclFSNonnativePathType( */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); while (fsRecPtr != NULL) { /* * We want to skip the native filesystem in this loop because @@ -4111,6 +4165,7 @@ TclFSNonnativePathType( } fsRecPtr = fsRecPtr->nextPtr; } + Disclaim(); return type; } @@ -4498,10 +4553,14 @@ Tcl_FSGetFileSystemForPath( */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); + if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) { + Disclaim(); return NULL; } else if (retVal != NULL) { /* TODO: Can this happen? */ + Disclaim(); return retVal; } @@ -4524,9 +4583,11 @@ Tcl_FSGetFileSystemForPath( */ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); + Disclaim(); return fsRecPtr->fsPtr; } } + Disclaim(); return NULL; } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 97517ea..9f73a31 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1095,6 +1095,11 @@ declare 16 win { # declare 17 win { # char *TclpGetTZName(void) # } +# new for 8.5.12+ Cygwin only +declare 17 win { + int TclUnixCopyFile(const char *src, const char *dst, + const Tcl_StatBuf *statBufPtr, int dontCopyAtts) +} declare 18 win { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 9068dfb..53a88d6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2920,6 +2920,10 @@ MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); +MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, + Tcl_Obj *objPtr); +MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); @@ -4452,6 +4456,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- + * Convenience macros for DStrings. + * The ANSI C "prototypes" for these macros are: + * + * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr, + * const char *sLiteral); + * MODULE_SCOPE void TclDStringClear(Tcl_DString *dsPtr); + */ + +#define TclDStringAppendLiteral(dsPtr, sLiteral) \ + Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) +#define TclDStringClear(dsPtr) \ + Tcl_DStringSetLength((dsPtr), 0) + +/* + *---------------------------------------------------------------- * Macros used by the Tcl core to test for some special double values. * The ANSI C "prototypes" for these macros are: * diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index a9c6e8c..7322a37 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -140,7 +140,10 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, Tcl_Pid *pidPtr); /* 16 */ EXTERN int TclpIsAtty(int fd); -/* Slot 17 is reserved */ +/* 17 */ +EXTERN int TclUnixCopyFile(const char *src, const char *dst, + const Tcl_StatBuf *statBufPtr, + int dontCopyAtts); /* 18 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ @@ -289,7 +292,7 @@ typedef struct TclIntPlatStubs { int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */ int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ int (*tclpIsAtty) (int fd); /* 16 */ - void (*reserved17)(void); + int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ @@ -433,7 +436,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #define TclpIsAtty \ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ -/* Slot 17 is reserved */ +#define TclUnixCopyFile \ + (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ #define TclpOpenFile \ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 008a99d..ce4d6a4 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -198,9 +198,9 @@ Tcl_LoadObjCmd( if (packageName == NULL) { namesMatch = 0; } else { - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); - Tcl_DStringSetLength(&tmp, 0); + TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); @@ -211,7 +211,7 @@ Tcl_LoadObjCmd( namesMatch = 0; } } - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { @@ -329,7 +329,7 @@ Tcl_LoadObjCmd( code = TCL_ERROR; goto done; } - Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); + Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); } } @@ -348,14 +348,14 @@ Tcl_LoadObjCmd( * package name. */ - Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&initName, "_Init", 5); - Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); - Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&unloadName, "_Unload", 7); - Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1); - Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11); + TclDStringAppendDString(&initName, &pkgName); + TclDStringAppendLiteral(&initName, "_Init"); + TclDStringAppendDString(&safeInitName, &pkgName); + TclDStringAppendLiteral(&safeInitName, "_SafeInit"); + TclDStringAppendDString(&unloadName, &pkgName); + TclDStringAppendLiteral(&unloadName, "_Unload"); + TclDStringAppendDString(&safeUnloadName, &pkgName); + TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload"); /* * Call platform-specific code to load the package and find the two @@ -623,9 +623,9 @@ Tcl_UnloadObjCmd( if (packageName == NULL) { namesMatch = 0; } else { - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); Tcl_DStringAppend(&pkgName, packageName, -1); - Tcl_DStringSetLength(&tmp, 0); + TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1); Tcl_UtfToLower(Tcl_DStringValue(&pkgName)); Tcl_UtfToLower(Tcl_DStringValue(&tmp)); @@ -636,7 +636,7 @@ Tcl_UnloadObjCmd( namesMatch = 0; } } - Tcl_DStringSetLength(&pkgName, 0); + TclDStringClear(&pkgName); filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0); if (filesMatch && (namesMatch || (packageName == NULL))) { diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 73bc644..6a241f0 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -24,7 +24,7 @@ */ #include "tclInt.h" -#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */ +#include "tclCompile.h" /* for TclLogCommandInfo visibility */ /* * Thread-local storage used to avoid having a global lock on data that is not @@ -803,10 +803,9 @@ Tcl_CreateNamespace( if (ancestorPtr != globalNsPtr) { register Tcl_DString *tempPtr = namePtr; - Tcl_DStringAppend(buffPtr, "::", 2); + TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); - Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr), - Tcl_DStringLength(namePtr)); + TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous @@ -814,7 +813,7 @@ Tcl_CreateNamespace( * very wrong (and strange). */ - Tcl_DStringSetLength(namePtr, 0); + TclDStringClear(namePtr); /* * Now swap the buffer pointers so that we build in the other @@ -916,7 +915,7 @@ Tcl_DeleteNamespace( for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL;) { cmdPtr = Tcl_GetHashValue(entryPtr); - if (cmdPtr->nreProc == NRInterpCoroutine) { + if (cmdPtr->nreProc == TclNRInterpCoroutine) { Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, (Tcl_Command) cmdPtr); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); @@ -1667,7 +1666,7 @@ DoImport( Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, cmdName, -1); @@ -2241,7 +2240,7 @@ TclGetNamespaceForQualName( * qualName since it may be a string constant. */ - Tcl_DStringSetLength(&buffer, 0); + TclDStringClear(&buffer); Tcl_DStringAppend(&buffer, start, len); nsName = Tcl_DStringValue(&buffer); } @@ -2916,7 +2915,7 @@ NamespaceChildrenCmd( } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); } Tcl_DStringAppend(&buffer, name, -1); pattern = Tcl_DStringValue(&buffer); diff --git a/generic/tclOO.c b/generic/tclOO.c index 26e6d75..821befd 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -356,14 +356,14 @@ InitFoundation( Tcl_DStringInit(&buffer); for (i=0 ; defineCmds[i].name ; i++) { - Tcl_DStringAppend(&buffer, "::oo::define::", 14); + TclDStringAppendLiteral(&buffer, "::oo::define::"); Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i=0 ; objdefCmds[i].name ; i++) { - Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17); + TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); @@ -657,7 +657,7 @@ AllocObject( Tcl_DStringInit(&buffer); Tcl_DStringAppend(&buffer, Tcl_GetCurrentNamespace(interp)->fullName, -1); - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, nameStr, -1); oPtr->command = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL); diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 5e983fc..35ad1eb 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1190,7 +1190,7 @@ TclOOCopyObjectCmd( Tcl_DStringAppend(&buffer, iPtr->varFramePtr->nsPtr->fullName, -1); } - Tcl_DStringAppend(&buffer, "::", 2); + TclDStringAppendLiteral(&buffer, "::"); Tcl_DStringAppend(&buffer, name, -1); name = Tcl_DStringValue(&buffer); } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 06ee984..8bae4fb 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -27,6 +27,8 @@ static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); static int FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); +static int MakePathFromNormalized(Tcl_Interp *interp, + Tcl_Obj *pathPtr); /* * Define the 'path' object type, which Tcl uses to represent file paths @@ -432,7 +434,7 @@ TclFSNormalizeAbsolutePath( * object into an FsPath for greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal); + MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. @@ -564,8 +566,7 @@ TclPathPart( if (pathPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); - if (TclFSEpochOk(fsPathPtr->filesystemEpoch) - && (PATHFLAGS(pathPtr) != 0)) { + if (PATHFLAGS(pathPtr) != 0) { switch (portion) { case TCL_PATH_DIRNAME: { /* @@ -1263,7 +1264,6 @@ TclNewFSPathObj( { FsPath *fsPathPtr; Tcl_Obj *pathPtr; - ThreadSpecificData *tsdPtr; const char *p; int state = 0, count = 0; @@ -1291,8 +1291,6 @@ TclNewFSPathObj( return pathPtr; } - tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - pathPtr = Tcl_NewObj(); fsPathPtr = ckalloc(sizeof(FsPath)); @@ -1307,7 +1305,7 @@ TclNewFSPathObj( Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = 0; SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; @@ -1461,7 +1459,7 @@ TclFSMakePathRelative( /* *--------------------------------------------------------------------------- * - * TclFSMakePathFromNormalized -- + * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. @@ -1475,13 +1473,12 @@ TclFSMakePathRelative( *--------------------------------------------------------------------------- */ -int -TclFSMakePathFromNormalized( +static int +MakePathFromNormalized( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -1524,7 +1521,8 @@ TclFSMakePathFromNormalized( fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + /* Remember the epoch under which we decided pathPtr was normalized */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; @@ -1566,7 +1564,6 @@ Tcl_FSNewNativePath( Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); @@ -1602,7 +1599,7 @@ Tcl_FSNewNativePath( fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsPtr = fromFilesystem; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; @@ -1660,6 +1657,12 @@ Tcl_FSGetTranslatedPath( retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1, &srcFsPathPtr->normPathPtr); srcFsPathPtr->translatedPathPtr = retObj; + if (translatedCwdPtr->typePtr == &tclFsPathType) { + srcFsPathPtr->filesystemEpoch + = PATHOBJ(translatedCwdPtr)->filesystemEpoch; + } else { + srcFsPathPtr->filesystemEpoch = 0; + } Tcl_IncrRefCount(retObj); Tcl_DecrRefCount(translatedCwdPtr); } else { @@ -2203,7 +2206,6 @@ TclFSSetPathDetails( const Tcl_Filesystem *fsPtr, ClientData clientData) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); FsPath *srcFsPathPtr; /* @@ -2219,7 +2221,7 @@ TclFSSetPathDetails( srcFsPathPtr = PATHOBJ(pathPtr); srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; - srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* @@ -2308,7 +2310,6 @@ SetFsPathFromAny( FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -2462,12 +2463,15 @@ SetFsPathFromAny( fsPathPtr->translatedPathPtr = transPtr; if (transPtr != pathPtr) { Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + /* Redo translation when $env(HOME) changes */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); + } else { + fsPathPtr->filesystemEpoch = 0; } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; /* * Free old representation before installing our new one. diff --git a/generic/tclPkg.c b/generic/tclPkg.c index fdaea57..382ffe3 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1712,11 +1712,11 @@ AddRequirementsToDString( int i; for (i = 0; i < reqc; i++) { - Tcl_DStringAppend(dsPtr, " ", 1); - Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1); + TclDStringAppendLiteral(dsPtr, " "); + TclDStringAppendObj(dsPtr, reqv[i]); } } else { - Tcl_DStringAppend(dsPtr, " 0-", -1); + TclDStringAppendLiteral(dsPtr, " 0-"); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index 7b0af3a..537008c 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -194,7 +194,7 @@ Tcl_ProcObjCmd( Tcl_DStringInit(&ds); if (nsPtr != iPtr->globalNsPtr) { Tcl_DStringAppend(&ds, nsPtr->fullName, -1); - Tcl_DStringAppend(&ds, "::", 2); + TclDStringAppendLiteral(&ds, "::"); } Tcl_DStringAppend(&ds, procName, -1); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1b671d4..ca2638c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -55,6 +55,7 @@ static int TclSockMinimumBuffersOld(int sock, int size) #ifdef __WIN32__ # define TclUnixWaitForFile 0 +# define TclUnixCopyFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) @@ -498,7 +499,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ - 0, /* 17 */ + TclUnixCopyFile, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 25abdff..529c38a 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1298,9 +1298,9 @@ TraceCommandProc( Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { - Tcl_DStringAppend(&cmd, " rename", 7); + TclDStringAppendLiteral(&cmd, " rename"); } else if (flags & TCL_TRACE_DELETE) { - Tcl_DStringAppend(&cmd, " delete", 7); + TclDStringAppendLiteral(&cmd, " delete"); } /* @@ -1994,24 +1994,24 @@ TraceVarProc( #ifndef TCL_REMOVE_OBSOLETE_TRACES if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) { if (flags & TCL_TRACE_ARRAY) { - Tcl_DStringAppend(&cmd, " a", 2); + TclDStringAppendLiteral(&cmd, " a"); } else if (flags & TCL_TRACE_READS) { - Tcl_DStringAppend(&cmd, " r", 2); + TclDStringAppendLiteral(&cmd, " r"); } else if (flags & TCL_TRACE_WRITES) { - Tcl_DStringAppend(&cmd, " w", 2); + TclDStringAppendLiteral(&cmd, " w"); } else if (flags & TCL_TRACE_UNSETS) { - Tcl_DStringAppend(&cmd, " u", 2); + TclDStringAppendLiteral(&cmd, " u"); } } else { #endif if (flags & TCL_TRACE_ARRAY) { - Tcl_DStringAppend(&cmd, " array", 6); + TclDStringAppendLiteral(&cmd, " array"); } else if (flags & TCL_TRACE_READS) { - Tcl_DStringAppend(&cmd, " read", 5); + TclDStringAppendLiteral(&cmd, " read"); } else if (flags & TCL_TRACE_WRITES) { - Tcl_DStringAppend(&cmd, " write", 6); + TclDStringAppendLiteral(&cmd, " write"); } else if (flags & TCL_TRACE_UNSETS) { - Tcl_DStringAppend(&cmd, " unset", 6); + TclDStringAppendLiteral(&cmd, " unset"); } #ifndef TCL_REMOVE_OBSOLETE_TRACES } @@ -2577,7 +2577,7 @@ TclCallVarTraces( char *newPart1; Tcl_DStringInit(&nameCopy); - Tcl_DStringAppend(&nameCopy, part1, (p-part1)); + Tcl_DStringAppend(&nameCopy, part1, p-part1); newPart1 = Tcl_DStringValue(&nameCopy); newPart1[offset] = 0; part1 = newPart1; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index d5a3b94..3379f6c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2438,6 +2438,37 @@ Tcl_DStringAppend( /* *---------------------------------------------------------------------- * + * TclDStringAppendObj, TclDStringAppendDString -- + * + * Simple wrappers round Tcl_DStringAppend that make it easier to append + * from particular sources of strings. + * + *---------------------------------------------------------------------- + */ + +char * +TclDStringAppendObj( + Tcl_DString *dsPtr, + Tcl_Obj *objPtr) +{ + int length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + + return Tcl_DStringAppend(dsPtr, bytes, length); +} + +char * +TclDStringAppendDString( + Tcl_DString *dsPtr, + Tcl_DString *toAppendPtr) +{ + return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr), + Tcl_DStringLength(toAppendPtr)); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DStringAppendElement -- * * Append a list element to the current value of a dynamic string. @@ -2793,9 +2824,9 @@ Tcl_DStringStartSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { - Tcl_DStringAppend(dsPtr, " {", -1); + TclDStringAppendLiteral(dsPtr, " {"); } else { - Tcl_DStringAppend(dsPtr, "{", -1); + TclDStringAppendLiteral(dsPtr, "{"); } } @@ -2821,7 +2852,7 @@ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { - Tcl_DStringAppend(dsPtr, "}", -1); + TclDStringAppendLiteral(dsPtr, "}"); } /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index c96594d..a4ce05b 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -766,9 +766,8 @@ Tcl_ZlibStreamInit( goto error; } Tcl_DStringInit(&cmdname); - Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1); - Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)), - -1); + TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); + TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname), &cmdinfo) == 1) { Tcl_SetResult(interp, @@ -3337,10 +3336,7 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { - int len; - const char *str = Tcl_GetStringFromObj(tmpObj, &len); - - Tcl_DStringAppend(dsPtr, str, len); + TclDStringAppendObj(dsPtr, tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; } @@ -3698,7 +3694,7 @@ ResultCopy( */ memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); - Tcl_DStringSetLength(&cd->decompressed, 0); + TclDStringClear(&cd->decompressed); return have; } } |