diff options
Diffstat (limited to 'generic')
48 files changed, 1676 insertions, 1365 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 8355d99..b421ae2 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2346,12 +2346,12 @@ declare 1 win { ################################ # Mac OS X specific functions -declare 0 {unix macosx} { +declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) } -declare 1 {unix macosx} { +declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) @@ -2365,6 +2365,14 @@ export { void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) } export { + const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, + int exact) +} +export { + const char *TclTomMathInitializeStubs(Tcl_Interp* interp, + const char* version, int epoch, int revision) +} +export { const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact) } 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 a66b8b2..4d6ff0c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -81,8 +81,6 @@ TCL_DECLARE_MUTEX(cancelLock) * are used to save the evaluation state between NR calls to each coro. */ -static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL}; - #define SAVE_CONTEXT(context) \ (context).framePtr = iPtr->framePtr; \ (context).varFramePtr = iPtr->varFramePtr; \ @@ -136,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; @@ -1545,12 +1545,16 @@ DeleteInterpProc( hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); + Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); + procPtr->iPtr = NULL; + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + } + ckfree(cfPtr->line); + ckfree(cfPtr); } - ckfree(cfPtr->line); - ckfree(cfPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); @@ -2589,7 +2593,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++; @@ -3447,7 +3451,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), @@ -4327,7 +4331,7 @@ TclNRRunCallbacks( return result; } -int +static int NRCommand( ClientData data[], Tcl_Interp *interp, @@ -8516,7 +8520,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 @@ -8743,7 +8747,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", @@ -8772,7 +8776,7 @@ NRCoroInjectObjCmd( } int -NRInterpCoroutine( +TclNRInterpCoroutine( ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -8894,12 +8898,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 70aef8d..f09ee70 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -61,6 +61,7 @@ static Tcl_NRPostProc ForPostNextCallback; static Tcl_NRPostProc ForeachLoopStep; static Tcl_NRPostProc EvalCmdErrMsg; +static Tcl_ObjCmdProc BadFileSubcommand; static Tcl_ObjCmdProc FileAttrAccessTimeCmd; static Tcl_ObjCmdProc FileAttrIsDirectoryCmd; static Tcl_ObjCmdProc FileAttrIsExecutableCmd; @@ -581,7 +582,7 @@ Tcl_EncodingObjCmd( break; } case ENC_DIRS: - return EncodingDirsObjCmd(dummy, interp, objc-1, objv+1); + return EncodingDirsObjCmd(dummy, interp, objc, objv); case ENC_NAMES: if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); @@ -628,22 +629,26 @@ EncodingDirsObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?dirList?"); + Tcl_Obj *dirListObj; + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?dirList?"); return TCL_ERROR; } - 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; } @@ -1040,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; @@ -1057,6 +1062,8 @@ TclMakeFileCommandSafe( unsafeInfo[i].cmdName, Tcl_GetString(Tcl_GetObjResult(interp))); } + Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand, + (ClientData) unsafeInfo[i].cmdName, NULL); } } Tcl_DStringFree(&oldBuf); @@ -1078,6 +1085,39 @@ TclMakeFileCommandSafe( /* *---------------------------------------------------------------------- * + * BadFileSubcommand -- + * + * Command used to act as a backstop implementation when subcommands of + * "file" are unsafe (the real implementations of the subcommands are + * hidden). The clientData is always the full official subcommand name. + * + * Results: + * A standard Tcl result (always a TCL_ERROR). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +BadFileSubcommand( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + const char *subcommandName = (const char *) clientData; + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "not allowed to invoke subcommand %s of file", subcommandName)); + Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * * FileAttrAccessTimeCmd -- * * This function is invoked to process the "file atime" Tcl command. See diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index c5bb72d..7e94d9f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3758,8 +3758,12 @@ TclNRSwitchObjCmd( if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; - rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); - rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end); + if (info.matches[j].end > 0) { + rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); + rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1); + } else { + rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1); + } /* * Never fails; the object is always clean at this point. 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/tclDecls.h b/generic/tclDecls.h index 75dbd9a..1e2a68b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1830,7 +1830,7 @@ typedef struct TclStubs { #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) /* WIN */ void (*reserved9)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -1839,7 +1839,7 @@ typedef struct TclStubs { #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) /* WIN */ void (*reserved10)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -2004,7 +2004,7 @@ typedef struct TclStubs { #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) /* WIN */ void (*reserved167)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ 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 72d6fba..b5ae6ea 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -698,6 +698,7 @@ TclFinalizeEnvironment(void) * fork) and the Windows environment (in case the application TCL code calls * exec, which calls the Windows CreateProcess function). */ +DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *); static void TclCygwinPutenv( @@ -771,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 5048308..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; } @@ -424,9 +424,17 @@ TclpGetNativePathType( } #endif if (path[0] == '/') { +#ifdef __CYGWIN__ + /* + * Check for Cygwin // network path prefix + */ + if (path[1] == '/') { + path++; + } +#endif if (driveNameLengthPtr != NULL) { /* - * We need this addition in case the QNX code was used. + * We need this addition in case the QNX or Cygwin code was used. */ *driveNameLengthPtr = (1 + path - origPath); @@ -653,11 +661,20 @@ SplitUnixPath( } #endif - if (path[0] == '/') { - Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1)); - p = path+1; - } else { - p = path; + p = path; + if (*p == '/') { + Tcl_Obj *rootElt = Tcl_NewStringObj("/", 1); + p++; +#ifdef __CYGWIN__ + /* + * Check for Cygwin // network path prefix + */ + if (*p == '/') { + Tcl_AppendToObj(rootElt, "/", 1); + p++; + } +#endif + Tcl_ListObjAppendElement(NULL, result, rootElt); } /* @@ -863,7 +880,7 @@ TclpNativeJoinPath( if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -899,7 +916,7 @@ TclpNativeJoinPath( if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -1040,7 +1057,7 @@ Tcl_TranslateFileName( } Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); + TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); @@ -1396,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') { @@ -1558,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); } @@ -1575,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; @@ -2384,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, "."); } } @@ -2395,22 +2409,11 @@ 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, "."); } } -#if defined(__CYGWIN__) && !defined(__WIN32__) - { - DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, - char *); - char winbuf[MAXPATHLEN+1]; - - cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf); - Tcl_DStringFree(&append); - Tcl_DStringAppend(&append, winbuf, -1); - } -#endif /* __CYGWIN__ && __WIN32__ */ break; } diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 5e48dec..6be3e03 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -16,45 +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. */ - int fileRefCount; /* How many Tcl_Obj's use this filesystem. */ - 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. * @@ -62,31 +23,23 @@ typedef struct ThreadSpecificData { */ MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr); -MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp, - Tcl_Obj *pathPtr, ClientData clientData); MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp, - Tcl_Obj *pathPtr, int startAt, - ClientData *clientDataPtr); + Tcl_Obj *pathPtr, int startAt); MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr); -MODULE_SCOPE Tcl_Obj * TclFSInternalToNormalized( - const Tcl_Filesystem *fromFilesystem, - ClientData clientData, - FilesystemRecord **fsRecPtrPtr); MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, - FilesystemRecord *fsRecPtr, - ClientData clientData); + const Tcl_Filesystem *fsPtr, ClientData clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, - Tcl_Obj *pathPtr, ClientData *clientDataPtr); + 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 96e6de3..ea6c2d7 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -396,6 +396,19 @@ TclFinalizeIOSubsystem(void) Channel *chanPtr = NULL; /* Iterates over open channels. */ ChannelState *statePtr; /* State of channel stack */ int active = 1; /* Flag == 1 while there's still work to do */ + int doflushnb; + + /* Fetch the pre-TIP#398 compatibility flag */ + { + const char *s; + Tcl_DString ds; + + s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); + doflushnb = ((s != NULL) && strcmp(s, "0")); + if (s != NULL) { + Tcl_DStringFree(&ds); + } + } /* * Walk all channel state structures known to this thread and close @@ -414,25 +427,34 @@ TclFinalizeIOSubsystem(void) statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; - if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD) + if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD) || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; } } /* - * We've found a live channel. Close it. + * We've found a live (or bg-closing) channel. Close it. */ if (active) { + /* - * Set the channel back into blocking mode to ensure that we wait - * for all data to flush out. + * TIP #398: by default, we no longer set the channel back into + * blocking mode. To restore the old blocking behavior, the + * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set + * and not be "0". */ - - (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); + if (doflushnb) { + /* Set the channel back into blocking mode to ensure that we wait + * for all data to flush out. + */ + + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, + "-blocking", "on"); + } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || @@ -458,7 +480,6 @@ TclFinalizeIOSubsystem(void) * The refcount is greater than zero, so flush the channel. */ - ResetFlag(statePtr, BG_FLUSH_SCHEDULED); Tcl_Flush((Tcl_Channel) chanPtr); /* @@ -4410,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; @@ -7529,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), @@ -8398,8 +8417,8 @@ UpdateInterest( mask &= ~TCL_EXCEPTION; if (!statePtr->timer) { - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, - chanPtr); + statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ChannelTimerProc, chanPtr); } } } @@ -8440,7 +8459,8 @@ ChannelTimerProc( * before UpdateInterest gets called by Tcl_NotifyChannel. */ - statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr); + statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ChannelTimerProc,chanPtr); #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING /* @@ -8739,7 +8759,7 @@ CreateScriptRecord( /* * Initialize the structure before calling Tcl_CreateChannelHandler, - * because a reflected channel caling 'chan postevent' aka + * because a reflected channel calling 'chan postevent' aka * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to * see uninitialized memory and crash. See [Bug 2918110]. @@ -8856,7 +8876,7 @@ Tcl_FileEventObjCmd( int modeIndex; /* Index of mode argument. */ int mask; static const char *const modeOptions[] = {"readable", "writable", NULL}; - static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; + static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); diff --git a/generic/tclIO.h b/generic/tclIO.h index 3283c3e..1e89878 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -423,6 +423,13 @@ typedef struct GetsState { * appended to objPtr so far, just before the * last call to FilterInputBytes(). */ } GetsState; + +/* + * The length of time to wait between synthetic timer events. Must be zero or + * bad things tend to happen. + */ + +#define SYNTHETIC_EVENT_TIME 0 /* * Local Variables: diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index b22d746..59856d0 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -521,7 +521,7 @@ Tcl_SeekObjCmd( static const char *const originOptions[] = { "start", "current", "end", NULL }; - static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; + static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 49e2930..6fec40a 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -39,6 +39,9 @@ static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); +#ifdef TCL_THREADS +static void ReflectThread(ClientData clientData, int action); +#endif static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); static int ReflectSeek(ClientData clientData, long offset, @@ -71,7 +74,11 @@ static const Tcl_ChannelType tclRChannelType = { NULL, /* Flush channel. Not used by core. NULL'able */ NULL, /* Handle events. NULL'able */ ReflectSeekWide, /* Move access point (64 bit). NULL'able */ +#ifdef TCL_THREADS + ReflectThread, /* thread action, tracking owner */ +#else NULL, /* thread action */ +#endif NULL /* truncate */ }; @@ -89,7 +96,8 @@ typedef struct { * command is gone. */ #ifdef TCL_THREADS - Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ + Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif /* See [==] as well. @@ -390,7 +398,7 @@ TCL_DECLARE_MUTEX(rcForwardMutex) * leak resources when threads go away. */ -static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, +static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); @@ -765,6 +773,48 @@ TclChanCreateObjCmd( *---------------------------------------------------------------------- */ +typedef struct ReflectEvent { + Tcl_Event header; + ReflectedChannel* rcPtr; + int events; +} ReflectEvent; + +static int +ReflectEventRun (Tcl_Event* ev, int flags) +{ + /* OWNER thread + * + * Note: When the channel is closed any pending events of this type are + * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls + * accomplishing that. + */ + + ReflectEvent* e = (ReflectEvent*) ev; + + Tcl_NotifyChannel (e->rcPtr->chan, e->events); + return 1; +} + +static int +ReflectEventDelete (Tcl_Event* ev, ClientData cd) +{ + /* OWNER thread + * + * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The + * latter ensures that no pending events of this type are run on an + * invalid channel. + */ + + ReflectEvent* e = (ReflectEvent*) ev; + + if ((ev->proc != ReflectEventRun) || + ((cd != NULL) && + (cd != e->rcPtr))) { + return 0; + } + return 1; +} + int TclChanPostEventObjCmd( ClientData clientData, @@ -773,6 +823,8 @@ TclChanPostEventObjCmd( Tcl_Obj *const *objv) { /* + * Ensure -> HANDLER thread + * * Syntax: chan postevent CHANNEL EVENTSPEC * [0] [1] [2] [3] * @@ -882,7 +934,41 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ - Tcl_NotifyChannel(chan, events); +#ifdef TCL_THREADS + if (rcPtr->owner == rcPtr->thread) { +#endif + Tcl_NotifyChannel (chan, events); +#ifdef TCL_THREADS + } else { + ReflectEvent* ev = ckalloc (sizeof (ReflectEvent)); + ev->header.proc = ReflectEventRun; + ev->events = events; + ev->rcPtr = rcPtr; + + /* + * We are not preserving the structure here. When the channel is + * closed any pending events are deleted, see ReflectClose(), and + * ReflectEventDelete(). Trying to preserve and later release when the + * event is run may generate a situation where the channel structure + * is deleted but not our structure, crashing in + * FreeReflectedChannel(). + * + * Force creation of the RCM, for proper cleanup on thread teardown. + * The teardown of unprocessed events is currently coupled to the + * thread reflected channel map + */ + (void) GetThreadReflectedChannelMap (); + + /* XXX Race condition !! + * XXX The destination thread may not exist anymore already. + * XXX (Delayed postevent executed after channel got removed). + * XXX Can we detect this ? (check the validity of the owner threadid ?) + * XXX Actually, in that case the channel should be dead also ! + */ + Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL); + Tcl_ThreadAlert (rcPtr->owner); + } +#endif /* * Squash interp results left by the event script. @@ -1067,9 +1153,12 @@ ReflectClose( if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; + /* Now squash the pending reflection events for this channel. */ + Tcl_DeleteEvents (ReflectEventDelete, rcPtr); + if (result != TCL_OK) { FreeReceivedError(&p); } @@ -1100,9 +1189,12 @@ ReflectClose( if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; + /* Now squash the pending reflection events for this channel. */ + Tcl_DeleteEvents (ReflectEventDelete, rcPtr); + Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); if (result != TCL_OK) { @@ -1207,7 +1299,7 @@ ReflectInput( p.input.buf = buf; p.input.toRead = toRead; - ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { @@ -1322,7 +1414,7 @@ ReflectOutput( p.output.buf = buf; p.output.toWrite = toWrite; - ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { @@ -1438,7 +1530,7 @@ ReflectSeekWide( p.seek.seekMode = seekMode; p.seek.offset = offset; - ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1562,7 +1654,7 @@ ReflectWatch( ForwardParam p; p.watch.mask = mask; - ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p); /* * Any failure from the forward is ignored. We have no place to put @@ -1620,7 +1712,7 @@ ReflectBlock( p.block.nonblocking = nonblocking; - ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1650,6 +1742,42 @@ ReflectBlock( return errorNum; } +#ifdef TCL_THREADS +/* + *---------------------------------------------------------------------- + * + * ReflectThread -- + * + * This function is invoked to tell the channel about thread movements. + * + * Results: + * None. + * + * Side effects: + * Allocates memory. Arbitrary, as it calls upon a script. + * + *---------------------------------------------------------------------- + */ + +static void +ReflectThread(ClientData clientData, int action) +{ + ReflectedChannel *rcPtr = clientData; + + switch (action) { + case TCL_CHANNEL_THREAD_INSERT: + rcPtr->owner = Tcl_GetCurrentThread(); + break; + case TCL_CHANNEL_THREAD_REMOVE: + rcPtr->owner = NULL; + break; + default: + Tcl_Panic ("Unknown thread action code."); + break; + } +} + +#endif /* *---------------------------------------------------------------------- * @@ -1689,7 +1817,7 @@ ReflectSetOption( p.setOpt.name = optionName; p.setOpt.value = newValue; - ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -1775,7 +1903,7 @@ ReflectGetOption( opcode = ForwardedGetOpt; } - ForwardOpToOwnerThread(rcPtr, opcode, &p); + ForwardOpToHandlerThread(rcPtr, opcode, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -1819,7 +1947,7 @@ ReflectGetOption( */ if (optionObj != NULL) { - Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1); + TclDStringAppendObj(dsPtr, resObj); goto ok; } @@ -1854,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; @@ -2673,6 +2801,15 @@ DeleteThreadReflectedChannelMap( Tcl_MutexUnlock(&rcForwardMutex); /* + * Run over the event queue of this thread and remove all ReflectEvent's + * still pending. These are inbound events for reflected channels this + * thread owns but doesn't handle. The inverse of the channel map + * actually. + */ + + Tcl_DeleteEvents (ReflectEventDelete, NULL); + + /* * Get the map of all channels handled by the current thread. This is a * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go * through the channels, remove all, mark them as dead. @@ -2693,11 +2830,16 @@ DeleteThreadReflectedChannelMap( } static void -ForwardOpToOwnerThread( +ForwardOpToHandlerThread( ReflectedChannel *rcPtr, /* Channel instance */ ForwardedOperation op, /* Forwarded driver operation */ const void *param) /* Arguments */ { + /* + * Core of the communication from OWNER to HANDLER thread. + * The receiver is ForwardProc() below. + */ + Tcl_ThreadId dst = rcPtr->thread; ForwardingEvent *evPtr; ForwardingResult *resultPtr; @@ -2750,7 +2892,7 @@ ForwardOpToOwnerThread( /* * Ensure cleanup of the event if the origin thread exits while this event * is pending or in progress. Exit of the destination thread is handled by - * DeleteThreadReflectionChannelMap(), this is set up by + * DeleteThreadReflectedChannelMap(), this is set up by * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' * (see above) for. */ @@ -2765,7 +2907,7 @@ ForwardOpToOwnerThread( Tcl_ThreadAlert(dst); /* - * (*) Block until the other thread has either processed the transfer or + * (*) Block until the handler thread has either processed the transfer or * rejected it. */ @@ -2813,6 +2955,11 @@ ForwardProc( int mask) { /* + * HANDLER thread. + + * The receiver part for the operations coming from the OWNER thread. + * See ForwardOpToHandlerThread() for the transmitter. + * * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see @@ -3060,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); @@ -3086,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); @@ -3106,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/tclIORTrans.c b/generic/tclIORTrans.c index 6c9a41b..8f111b0 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -439,13 +439,6 @@ static const char *msg_dstlost = */ /* - * Number of milliseconds to wait before firing an event to try to flush out - * information waiting in buffers (fileevent support). - */ - -#define FLUSH_DELAY (5) - -/* * Helper functions encapsulating some of the thread forwarding to make the * control flow in callers easier. */ @@ -1230,7 +1223,7 @@ ReflectInput( * * ReflectOutput -- * - * This function is invoked when data is writen to the channel. + * This function is invoked when data is written to the channel. * * Results: * The number of bytes actually written. @@ -2861,7 +2854,8 @@ TimerSetup( return; } - rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr); + rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + TimerRun, rtPtr); } /* diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 7b7b647..018f9f5 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -87,8 +87,8 @@ TclSockGetPort( *---------------------------------------------------------------------- */ -#ifndef _WIN32 -# define SOCKET size_t +#if !defined(_WIN32) && !defined(__CYGWIN__) +# define SOCKET int #endif int @@ -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,7 +206,13 @@ TclCreateSocketAddress( } if (result != 0) { - goto error; +#ifdef EAI_SYSTEM /* Doesn't exist on Windows */ + if (result == EAI_SYSTEM) + *errorMsgPtr = Tcl_PosixError(interp); + else +#endif + *errorMsgPtr = gai_strerror(result); + return 0; } /* @@ -249,33 +255,6 @@ TclCreateSocketAddress( } return 1; - - /* - * Ought to use gai_strerror() here... - */ - -error: - switch (result) { - case EAI_NONAME: - case EAI_SERVICE: -#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME - case EAI_ADDRFAMILY: -#endif -#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME - case EAI_NODATA: -#endif - *errorMsgPtr = gai_strerror(result); - errno = EHOSTUNREACH; - return 0; -#ifdef EAI_SYSTEM - case EAI_SYSTEM: - return 0; -#endif - default: - *errorMsgPtr = gai_strerror(result); - errno = ENXIO; - return 0; - } } /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index c4e7db0..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); @@ -163,7 +201,6 @@ const Tcl_Filesystem tclNativeFilesystem = { static FilesystemRecord nativeFilesystemRecord = { NULL, &tclNativeFilesystem, - 1, NULL, NULL }; @@ -175,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 @@ -195,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 @@ -368,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); } @@ -419,9 +456,8 @@ FsThrExitProc( fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; - if (--fsRecPtr->fileRefCount <= 0) { - ckfree(fsRecPtr); - } + fsRecPtr->fsPtr = NULL; + ckfree(fsRecPtr); fsRecPtr = tmpFsRecPtr; } tsdPtr->initialized = 0; @@ -430,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; @@ -464,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 @@ -523,12 +559,11 @@ TclFSCwdPointerEquals( } } -#ifdef TCL_THREADS static void FsRecacheFilesystemList(void) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); + FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list; /* * Trash the current cache. @@ -537,20 +572,16 @@ FsRecacheFilesystemList(void) fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; - if (--fsRecPtr->fileRefCount <= 0) { - ckfree(fsRecPtr); - } + 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; @@ -561,18 +592,26 @@ 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; + } /* * Make sure the above gets released on thread exit. @@ -583,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; } /* @@ -616,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. @@ -633,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); @@ -730,17 +776,14 @@ TclFinalizeFilesystem(void) while (fsRecPtr != NULL) { FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr; - if (fsRecPtr->fileRefCount <= 0) { - /* - * The native filesystem is static, so we don't free it. - */ + /* The native filesystem is static, so we don't free it. */ - if (fsRecPtr->fsPtr != &tclNativeFilesystem) { - ckfree(fsRecPtr); - } + if (fsRecPtr != &nativeFilesystemRecord) { + ckfree(fsRecPtr); } fsRecPtr = tmpFsRecPtr; } + theFilesystemEpoch++; filesystemList = NULL; /* @@ -773,11 +816,7 @@ void TclResetFilesystem(void) { filesystemList = &nativeFilesystemRecord; - - /* - * Note, at this point, I believe nativeFilesystemRecord -> fileRefCount - * should equal 1 and if not, we should try to track down the cause. - */ + theFilesystemEpoch++; #ifdef __WIN32__ /* @@ -836,13 +875,6 @@ Tcl_FSRegister( newFilesystemPtr->fsPtr = fsPtr; /* - * We start with a refCount of 1. If this drops to zero, then anyone is - * welcome to ckfree us. - */ - - newFilesystemPtr->fileRefCount = 1; - - /* * Is this lock and wait strictly speaking necessary? Since any iterators * out there will have grabbed a copy of the head of the list and be * iterating away from that, if we add a new element to the head of the @@ -915,7 +947,7 @@ Tcl_FSUnregister( */ fsRecPtr = filesystemList; - while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) { + while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) { if (fsRecPtr->fsPtr == fsPtr) { if (fsRecPtr->prevPtr) { fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr; @@ -936,10 +968,7 @@ Tcl_FSUnregister( theFilesystemEpoch++; - fsRecPtr->fileRefCount--; - if (fsRecPtr->fileRefCount <= 0) { - ckfree(fsRecPtr); - } + ckfree(fsRecPtr); retVal = TCL_OK; } else { @@ -1347,14 +1376,9 @@ int TclFSNormalizeToUniquePath( Tcl_Interp *interp, /* Used for error messages. */ Tcl_Obj *pathPtr, /* The path to normalize in place. */ - int startAt, /* Start at this char-offset. */ - ClientData *clientDataPtr) /* If we generated a complete normalized path - * for a given filesystem, we can optionally - * return an fs-specific clientdata here. */ + int startAt) /* Start at this char-offset. */ { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - /* Ignore this variable */ - (void) clientDataPtr; /* * Call each of the "normalise path" functions in succession. This is a @@ -1365,6 +1389,7 @@ TclFSNormalizeToUniquePath( firstFsRecPtr = FsGetFirstFilesystem(); + Claim(); for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { if (fsRecPtr->fsPtr != &tclNativeFilesystem) { continue; @@ -1402,6 +1427,7 @@ TclFSNormalizeToUniquePath( * but there's not much benefit. */ } + Disclaim(); return startAt; } @@ -2596,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; @@ -2608,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; @@ -2633,7 +2660,7 @@ Tcl_FSGetCwd( retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); - norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL); + norm = TclFSNormalizeAbsolutePath(interp,retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. We @@ -2654,6 +2681,7 @@ Tcl_FSGetCwd( } Tcl_DecrRefCount(retVal); retVal = NULL; + Disclaim(); goto cdDidNotChange; } else if (interp != NULL) { Tcl_AppendResult(interp, @@ -2661,6 +2689,7 @@ Tcl_FSGetCwd( Tcl_PosixError(interp), NULL); } } + Disclaim(); /* * Now the 'cwd' may NOT be normalized, at least on some platforms. @@ -2672,7 +2701,7 @@ Tcl_FSGetCwd( */ if (retVal != NULL) { - Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* @@ -2762,7 +2791,7 @@ Tcl_FSGetCwd( * Normalize the path. */ - norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + norm = TclFSNormalizeAbsolutePath(interp, retVal); /* * Check whether cwd has changed from the value previously stored in @@ -2944,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; @@ -3781,6 +3810,7 @@ Tcl_FSListVolumes(void) */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr->listVolumesProc != NULL) { Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); @@ -3792,6 +3822,7 @@ Tcl_FSListVolumes(void) } fsRecPtr = fsRecPtr->nextPtr; } + Disclaim(); return resultPtr; } @@ -3831,6 +3862,7 @@ FsListMounts( */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); while (fsRecPtr != NULL) { if (fsRecPtr->fsPtr != &tclNativeFilesystem && fsRecPtr->fsPtr->matchInDirectoryProc != NULL) { @@ -3842,6 +3874,7 @@ FsListMounts( } fsRecPtr = fsRecPtr->nextPtr; } + Disclaim(); return resultPtr; } @@ -3953,31 +3986,6 @@ Tcl_FSSplitPath( } return result; } - -/* Simple helper function. */ -Tcl_Obj * -TclFSInternalToNormalized( - const Tcl_Filesystem *fromFilesystem, - ClientData clientData, - FilesystemRecord **fsRecPtrPtr) -{ - FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); - - while (fsRecPtr != NULL) { - if (fsRecPtr->fsPtr == fromFilesystem) { - *fsRecPtrPtr = fsRecPtr; - break; - } - fsRecPtr = fsRecPtr->nextPtr; - } - - if ((fsRecPtr == NULL) - || (fromFilesystem->internalToNormalizedProc == NULL)) { - return NULL; - } - return fromFilesystem->internalToNormalizedProc(clientData); -} - /* *---------------------------------------------------------------------- * @@ -4079,6 +4087,7 @@ TclFSNonnativePathType( */ fsRecPtr = FsGetFirstFilesystem(); + Claim(); while (fsRecPtr != NULL) { /* * We want to skip the native filesystem in this loop because @@ -4156,6 +4165,7 @@ TclFSNonnativePathType( } fsRecPtr = fsRecPtr->nextPtr; } + Disclaim(); return type; } @@ -4543,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; } @@ -4568,10 +4582,12 @@ Tcl_FSGetFileSystemForPath( * call to the pathInFilesystemProc. */ - TclFSSetPathDetails(pathPtr, fsRecPtr, clientData); + TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData); + Disclaim(); return fsRecPtr->fsPtr; } } + Disclaim(); return NULL; } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index b206b35..85e0730 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -302,6 +302,10 @@ Tcl_GetIndexFromObjStruct( entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { + if (p1 == key) { + /* empty keys never match */ + continue; + } index = idx; goto done; } @@ -356,26 +360,31 @@ Tcl_GetIndexFromObjStruct( * Produce a fancy error message. */ - int count; + int count = 0; TclNewObj(resultPtr); + entryPtr = tablePtr; + while ((*entryPtr != NULL) && !**entryPtr) { + entryPtr = NEXT_ENTRY(entryPtr, offset); + } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); - if (STRING_AT(tablePtr, offset, 0) == NULL) { + if (*entryPtr == NULL) { Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL); } else { Tcl_AppendStringsToObj(resultPtr, "\": must be ", - STRING_AT(tablePtr, offset, 0), NULL); - for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; - *entryPtr != NULL; - entryPtr = NEXT_ENTRY(entryPtr, offset), count++) { + *entryPtr, NULL); + entryPtr = NEXT_ENTRY(entryPtr, offset); + while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); - } else { + } else if (**entryPtr) { Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); + count++; } + entryPtr = NEXT_ENTRY(entryPtr, offset); } } Tcl_SetObjResult(interp, resultPtr); diff --git a/generic/tclInt.decls b/generic/tclInt.decls index ad755bc..9f73a31 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -126,8 +126,8 @@ declare 25 { # } # Removed in 8.5 #declare 27 { -# int TclGetDate(char *p, Tcl_WideInt now, long zone, -# Tcl_WideInt *timePtr) +# int TclGetDate(char *p, unsigned long now, long zone, +# unsigned long *timePtr) #} declare 28 { Tcl_Channel TclpGetDefaultStdChannel(int type) @@ -188,7 +188,7 @@ declare 42 { } # Removed in Tcl 8.5a2 #declare 43 { -# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, +# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, # int flags) #} declare 44 { @@ -223,7 +223,7 @@ declare 51 { } # Removed in Tcl 8.5a2 #declare 52 { -# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv, +# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, # int flags) #} declare 53 { @@ -423,9 +423,6 @@ declare 103 { declare 104 { int TclSockMinimumBuffersOld(int sock, int size) } -declare 110 { - int TclSockMinimumBuffers(void *sock, int size) -} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -442,6 +439,9 @@ declare 108 { declare 109 { int TclUpdateReturnInfo(Interp *iPtr) } +declare 110 { + int TclSockMinimumBuffers(void *sock, int size) +} # Removed in 8.1: # declare 110 { # char *TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr) @@ -739,6 +739,16 @@ declare 177 { # Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) #} +# REMOVED +# Allocate lists without copying arrays +# declare 180 { +# Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv) +# } +#declare 181 { +# Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv, +# const char *file, int line) +#} + # TclpGmtime and TclpLocaltime promoted to the generic interface from unix declare 182 { @@ -1024,12 +1034,16 @@ declare 3 win { declare 4 win { HINSTANCE TclWinGetTclInstance(void) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 5 win { + int TclUnixWaitForFile(int fd, int mask, int timeout) +} # Removed in 8.1: # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } declare 6 win { - u_short TclWinNToHS(u_short ns) + unsigned short TclWinNToHS(unsigned short ns) } declare 7 win { int TclWinSetSockOpt(SOCKET s, int level, int optname, @@ -1041,6 +1055,10 @@ declare 8 win { declare 9 win { int TclWinGetPlatformId(void) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 10 win { + Tcl_DirEntry *TclpReaddir(DIR *dir) +} # Removed in 8.3.1 (for Win32s only) #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) @@ -1062,9 +1080,13 @@ declare 14 win { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 15 win { - int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, - TclFile inputFile, TclFile outputFile, TclFile errorFile, - Tcl_Pid *pidPtr) + int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr) +} +# new for 8.4.20+/8.5.12+ Cygwin only +declare 16 win { + int TclpIsAtty(int fd) } # Signature changed in 8.1: # declare 16 win { @@ -1073,6 +1095,11 @@ declare 15 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) } @@ -1082,7 +1109,10 @@ declare 19 win { declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } - +# new for 8.4.20+/8.5.12+ +declare 21 win { + char *TclpInetNtoa(struct in_addr addr) +} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -1127,51 +1157,42 @@ declare 29 win { # Pipe channel functions -# On non-cygwin, this is actually a reference to TclGetAndDetachPids declare 0 unix { - void TclWinConvertError(unsigned int errCode) + void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } -# On non-cygwin, this is actually a reference to TclpCloseFile declare 1 unix { - void TclWinConvertWSAError(unsigned int errCode) + int TclpCloseFile(TclFile file) } -# On non-cygwin, this is actually a reference to TclpCreateCommandChannel declare 2 unix { - struct servent *TclWinGetServByName(const char *nm, const char *proto) + Tcl_Channel TclpCreateCommandChannel(TclFile readFile, + TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } -# On non-cygwin, this is actually a reference to TclpCreatePipe declare 3 unix { - int TclWinGetSockOpt(void *s, int level, int optname, - char *optval, int *optlen) + int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } -# On non-cygwin, this is actually a reference to TclpCreateProcess declare 4 unix { - void *TclWinGetTclInstance(void) + int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, TclFile outputFile, + TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: # declare 5 unix { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) # } - -# On non-cygwin, this is actually a reference to TclpMakeFile declare 6 unix { - unsigned short TclWinNToHS(unsigned short ns) + TclFile TclpMakeFile(Tcl_Channel channel, int direction) } -# On non-cygwin, this is actually a reference to TclpOpenFile declare 7 unix { - int TclWinSetSockOpt(void *s, int level, int optname, - const char *optval, int optlen) + TclFile TclpOpenFile(const char *fname, int mode) } -# On non-cygwin, this is actually a reference to TclUnixWaitForFile declare 8 unix { - int TclpGetPid(Tcl_Pid pid) + int TclUnixWaitForFile(int fd, int mask, int timeout) } # Added in 8.1: -# On non-cygwin, this is actually a reference to TclpCreateTempFile declare 9 unix { - int TclWinGetPlatformId(void) + TclFile TclpCreateTempFile(const char *contents) } # Added in 8.4: @@ -1181,18 +1202,14 @@ declare 10 unix { } # Slots 11 and 12 are forwarders for functions that were promoted to # generic Stubs -# On cygwin, this is actually a reference to TclGetAndDetachPids declare 11 unix { struct tm *TclpLocaltime_unix(const time_t *clock) } -# On cygwin, this is actually a reference to TclpCloseFile declare 12 unix { struct tm *TclpGmtime_unix(const time_t *clock) } -# On cygwin, this is a reference to TclpCreateCommandChannel -# Otherwise, this is a reference to TclpInetNtoa declare 13 unix { - void TclIntPlatReserved13(void) + char *TclpInetNtoa(struct in_addr addr) } # Added in 8.5: @@ -1205,8 +1222,7 @@ declare 14 unix { ################################ # Mac OS X specific functions -#On cygwin, TclpCreateProcess is here -declare 15 {unix macosx} { +declare 15 macosx { int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr) } @@ -1218,67 +1234,17 @@ declare 17 macosx { int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr) } -#On cygwin, TclpMakeFile is here -declare 18 {unix macosx} { +declare 18 macosx { int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types) } -#On cygwin, TclpOpenFile is here -declare 19 {unix macosx} { +declare 19 macosx { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } -declare 20 unix { - void TclWinAddProcess(void *hProcess, unsigned int id) -} -declare 22 unix { - TclFile TclpCreateTempFile(const char *contents) -} -declare 24 unix { - char *TclWinNoBackslash(char *path) -} -declare 26 unix { - void TclWinSetInterfaces(int wide) -} -declare 27 unix { - void TclWinFlushDirtyChannels(void) -} -declare 28 unix { - void TclWinResetInterfaces(void) -} declare 29 unix { int TclWinCPUID(unsigned int index, unsigned int *regs) } -declare 30 unix { - void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) -} -declare 31 unix { - int TclpCloseFile(TclFile file) -} -declare 32 unix { - Tcl_Channel TclpCreateCommandChannel(TclFile readFile, - TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) -} -declare 33 unix { - int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) -} -declare 34 unix { - int TclpCreateProcess(Tcl_Interp *interp, - int argc, const char **argv, TclFile inputFile, - TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) -} -declare 35 unix { - char *TclpInetNtoa(struct in_addr addr) -} -declare 36 unix { - TclFile TclpMakeFile(Tcl_Channel channel, int direction) -} -declare 37 unix { - TclFile TclpOpenFile(const char *fname, int mode) -} -declare 38 unix { - int TclUnixWaitForFile(int fd, int mask, int timeout) -} # Local Variables: # mode: tcl diff --git a/generic/tclInt.h b/generic/tclInt.h index 56dc4a0..feb7fd4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2904,6 +2904,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); @@ -4436,6 +4440,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 bc0f4fd..7322a37 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -13,6 +13,11 @@ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS +#ifdef __WIN32__ +# define Tcl_DirEntry void +# define DIR void +#endif + #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT @@ -36,29 +41,32 @@ * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 0 */ -EXTERN void TclWinConvertError(unsigned int errCode); +EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, + Tcl_Channel chan); /* 1 */ -EXTERN void TclWinConvertWSAError(unsigned int errCode); +EXTERN int TclpCloseFile(TclFile file); /* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, - const char *proto); +EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, + TclFile writeFile, TclFile errorFile, + int numPids, Tcl_Pid *pidPtr); /* 3 */ -EXTERN int TclWinGetSockOpt(void *s, int level, int optname, - char *optval, int *optlen); +EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ -EXTERN void * TclWinGetTclInstance(void); +EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, + TclFile outputFile, TclFile errorFile, + Tcl_Pid *pidPtr); /* Slot 5 is reserved */ /* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ -EXTERN int TclWinSetSockOpt(void *s, int level, int optname, - const char *optval, int optlen); +EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); +EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ -EXTERN int TclWinGetPlatformId(void); +EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); /* 11 */ @@ -66,68 +74,29 @@ EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); /* 12 */ EXTERN struct tm * TclpGmtime_unix(const time_t *clock); /* 13 */ -EXTERN void TclIntPlatReserved13(void); +EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); -/* 15 */ -EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr); +/* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ -/* 18 */ -EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, - const char *pathName, const char *fileName, - Tcl_StatBuf *statBufPtr, - Tcl_GlobTypeData *types); -/* 19 */ -EXTERN void TclMacOSXNotifierAddRunLoopMode( - const void *runLoopMode); -/* 20 */ -EXTERN void TclWinAddProcess(void *hProcess, unsigned int id); +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* 22 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -/* 24 */ -EXTERN char * TclWinNoBackslash(char *path); +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); -/* 27 */ -EXTERN void TclWinFlushDirtyChannels(void); -/* 28 */ -EXTERN void TclWinResetInterfaces(void); +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); -/* 30 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, - Tcl_Channel chan); -/* 31 */ -EXTERN int TclpCloseFile(TclFile file); -/* 32 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, - TclFile writeFile, TclFile errorFile, - int numPids, Tcl_Pid *pidPtr); -/* 33 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); -/* 34 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, - const char **argv, TclFile inputFile, - TclFile outputFile, TclFile errorFile, - Tcl_Pid *pidPtr); -/* 35 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); -/* 36 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); -/* 37 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); -/* 38 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); /* 1 */ @@ -140,9 +109,10 @@ EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen); /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); -/* Slot 5 is reserved */ +/* 5 */ +EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ -EXTERN u_short TclWinNToHS(u_short ns); +EXTERN unsigned short TclWinNToHS(unsigned short ns); /* 7 */ EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen); @@ -150,7 +120,8 @@ EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, EXTERN int TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN int TclWinGetPlatformId(void); -/* Slot 10 is reserved */ +/* 10 */ +EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -167,15 +138,20 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); -/* Slot 16 is reserved */ -/* Slot 17 is reserved */ +/* 16 */ +EXTERN int TclpIsAtty(int fd); +/* 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 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); -/* Slot 21 is reserved */ +/* 21 */ +EXTERN char * TclpInetNtoa(struct in_addr addr); /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ @@ -193,27 +169,30 @@ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN void TclWinConvertError(unsigned int errCode); +EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, + Tcl_Channel chan); /* 1 */ -EXTERN void TclWinConvertWSAError(unsigned int errCode); +EXTERN int TclpCloseFile(TclFile file); /* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, - const char *proto); +EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, + TclFile writeFile, TclFile errorFile, + int numPids, Tcl_Pid *pidPtr); /* 3 */ -EXTERN int TclWinGetSockOpt(void *s, int level, int optname, - char *optval, int *optlen); +EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ -EXTERN void * TclWinGetTclInstance(void); +EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, + const char **argv, TclFile inputFile, + TclFile outputFile, TclFile errorFile, + Tcl_Pid *pidPtr); /* Slot 5 is reserved */ /* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ -EXTERN int TclWinSetSockOpt(void *s, int level, int optname, - const char *optval, int optlen); +EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); +EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ -EXTERN int TclWinGetPlatformId(void); +EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); /* 11 */ @@ -221,7 +200,7 @@ EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); /* 12 */ EXTERN struct tm * TclpGmtime_unix(const time_t *clock); /* 13 */ -EXTERN void TclIntPlatReserved13(void); +EXTERN char * TclpInetNtoa(struct in_addr addr); /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -246,117 +225,78 @@ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); -/* 20 */ -EXTERN void TclWinAddProcess(void *hProcess, unsigned int id); +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* 22 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -/* 24 */ -EXTERN char * TclWinNoBackslash(char *path); +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); -/* 27 */ -EXTERN void TclWinFlushDirtyChannels(void); -/* 28 */ -EXTERN void TclWinResetInterfaces(void); +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); -/* 30 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, - Tcl_Channel chan); -/* 31 */ -EXTERN int TclpCloseFile(TclFile file); -/* 32 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, - TclFile writeFile, TclFile errorFile, - int numPids, Tcl_Pid *pidPtr); -/* 33 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); -/* 34 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, - const char **argv, TclFile inputFile, - TclFile outputFile, TclFile errorFile, - Tcl_Pid *pidPtr); -/* 35 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); -/* 36 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); -/* 37 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); -/* 38 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); #endif /* MACOSX */ typedef struct TclIntPlatStubs { int magic; const struct TclIntPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tclWinConvertError) (unsigned int errCode); /* 0 */ - void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */ - struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ - int (*tclWinGetSockOpt) (void *s, int level, int optname, char *optval, int *optlen); /* 3 */ - void * (*tclWinGetTclInstance) (void); /* 4 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ + int (*tclpCloseFile) (TclFile file); /* 1 */ + Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ + int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ + int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ void (*reserved5)(void); - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (void *s, int level, int optname, const char *optval, int optlen); /* 7 */ - int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ + TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ + TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ + int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ + TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - void (*tclIntPlatReserved13) (void); /* 13 */ + char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ - int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ + void (*reserved15)(void); void (*reserved16)(void); void (*reserved17)(void); - int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ - void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ - void (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */ + void (*reserved18)(void); + void (*reserved19)(void); + void (*reserved20)(void); void (*reserved21)(void); - TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ + void (*reserved22)(void); void (*reserved23)(void); - char * (*tclWinNoBackslash) (char *path); /* 24 */ + void (*reserved24)(void); void (*reserved25)(void); - void (*tclWinSetInterfaces) (int wide); /* 26 */ - void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + void (*reserved26)(void); + void (*reserved27)(void); + void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ - void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */ - int (*tclpCloseFile) (TclFile file); /* 31 */ - Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 32 */ - int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 33 */ - int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 34 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 35 */ - TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 36 */ - TclFile (*tclpOpenFile) (const char *fname, int mode); /* 37 */ - int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 38 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ - void (*reserved5)(void); - u_short (*tclWinNToHS) (u_short ns); /* 6 */ + int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ + unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ - void (*reserved10)(void); + Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ 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 */ - void (*reserved16)(void); - void (*reserved17)(void); + int (*tclpIsAtty) (int fd); /* 16 */ + 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 */ - void (*reserved21)(void); + char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ @@ -367,45 +307,36 @@ typedef struct TclIntPlatStubs { int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - void (*tclWinConvertError) (unsigned int errCode); /* 0 */ - void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */ - struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ - int (*tclWinGetSockOpt) (void *s, int level, int optname, char *optval, int *optlen); /* 3 */ - void * (*tclWinGetTclInstance) (void); /* 4 */ + void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ + int (*tclpCloseFile) (TclFile file); /* 1 */ + Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */ + int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ + int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */ void (*reserved5)(void); - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (void *s, int level, int optname, const char *optval, int optlen); /* 7 */ - int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ + TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ + TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ + int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ + TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - void (*tclIntPlatReserved13) (void); /* 13 */ + char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ - void (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */ + void (*reserved20)(void); void (*reserved21)(void); - TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ + void (*reserved22)(void); void (*reserved23)(void); - char * (*tclWinNoBackslash) (char *path); /* 24 */ + void (*reserved24)(void); void (*reserved25)(void); - void (*tclWinSetInterfaces) (int wide); /* 26 */ - void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + void (*reserved26)(void); + void (*reserved27)(void); + void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ - void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */ - int (*tclpCloseFile) (TclFile file); /* 31 */ - Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 32 */ - int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 33 */ - int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 34 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 35 */ - TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 36 */ - TclFile (*tclpOpenFile) (const char *fname, int mode); /* 37 */ - int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 38 */ #endif /* MACOSX */ } TclIntPlatStubs; @@ -423,81 +354,54 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ -#define TclWinGetTclInstance \ - (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#define TclGetAndDetachPids \ + (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ +#define TclpCloseFile \ + (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ +#define TclpCreateCommandChannel \ + (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ +#define TclpCreatePipe \ + (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ +#define TclpCreateProcess \ + (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ /* Slot 5 is reserved */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ -#define TclpGetPid \ - (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +#define TclpMakeFile \ + (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ +#define TclpOpenFile \ + (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclpLocaltime_unix \ (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ #define TclpGmtime_unix \ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclIntPlatReserved13 \ - (tclIntPlatStubsPtr->tclIntPlatReserved13) /* 13 */ +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ -#define TclMacOSXGetFileAttribute \ - (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */ +/* Slot 15 is reserved */ /* Slot 16 is reserved */ /* Slot 17 is reserved */ -#define TclMacOSXMatchType \ - (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ -#define TclMacOSXNotifierAddRunLoopMode \ - (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ -#define TclWinAddProcess \ - (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#define TclpCreateTempFile \ - (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#define TclWinNoBackslash \ - (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ -#define TclWinFlushDirtyChannels \ - (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ -#define TclGetAndDetachPids \ - (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */ -#define TclpCloseFile \ - (tclIntPlatStubsPtr->tclpCloseFile) /* 31 */ -#define TclpCreateCommandChannel \ - (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 32 */ -#define TclpCreatePipe \ - (tclIntPlatStubsPtr->tclpCreatePipe) /* 33 */ -#define TclpCreateProcess \ - (tclIntPlatStubsPtr->tclpCreateProcess) /* 34 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 35 */ -#define TclpMakeFile \ - (tclIntPlatStubsPtr->tclpMakeFile) /* 36 */ -#define TclpOpenFile \ - (tclIntPlatStubsPtr->tclpOpenFile) /* 37 */ -#define TclUnixWaitForFile \ - (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 38 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ #define TclWinConvertWSAError \ @@ -508,7 +412,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ -/* Slot 5 is reserved */ +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ #define TclWinNToHS \ (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ #define TclWinSetSockOpt \ @@ -517,7 +422,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ -/* Slot 10 is reserved */ +#define TclpReaddir \ + (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -528,15 +434,18 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ -/* Slot 16 is reserved */ -/* Slot 17 is reserved */ +#define TclpIsAtty \ + (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ +#define TclUnixCopyFile \ + (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */ #define TclpOpenFile \ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -/* Slot 21 is reserved */ +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ @@ -553,33 +462,33 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ -#define TclWinGetTclInstance \ - (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ +#define TclGetAndDetachPids \ + (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ +#define TclpCloseFile \ + (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ +#define TclpCreateCommandChannel \ + (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ +#define TclpCreatePipe \ + (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ +#define TclpCreateProcess \ + (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ /* Slot 5 is reserved */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ -#define TclpGetPid \ - (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +#define TclpMakeFile \ + (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ +#define TclpOpenFile \ + (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclpLocaltime_unix \ (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ #define TclpGmtime_unix \ (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclIntPlatReserved13 \ - (tclIntPlatStubsPtr->tclIntPlatReserved13) /* 13 */ +#define TclpInetNtoa \ + (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -592,41 +501,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ -#define TclWinAddProcess \ - (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ -#define TclpCreateTempFile \ - (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ +/* Slot 22 is reserved */ /* Slot 23 is reserved */ -#define TclWinNoBackslash \ - (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ +/* Slot 24 is reserved */ /* Slot 25 is reserved */ -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ -#define TclWinFlushDirtyChannels \ - (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ -#define TclGetAndDetachPids \ - (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */ -#define TclpCloseFile \ - (tclIntPlatStubsPtr->tclpCloseFile) /* 31 */ -#define TclpCreateCommandChannel \ - (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 32 */ -#define TclpCreatePipe \ - (tclIntPlatStubsPtr->tclpCreatePipe) /* 33 */ -#define TclpCreateProcess \ - (tclIntPlatStubsPtr->tclpCreateProcess) /* 34 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 35 */ -#define TclpMakeFile \ - (tclIntPlatStubsPtr->tclpMakeFile) /* 36 */ -#define TclpOpenFile \ - (tclIntPlatStubsPtr->tclpOpenFile) /* 37 */ -#define TclUnixWaitForFile \ - (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 38 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ @@ -637,13 +522,12 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #define TCL_STORAGE_CLASS DLLIMPORT #undef TclpLocaltime_unix #undef TclpGmtime_unix -#undef TclIntPlatReserved13 #undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError -#if !defined(__WIN32__) -# undef TclpGetPid -# define TclpGetPid(pid) ((unsigned long) (pid)) +#if !defined(__WIN32__) && !defined(__CYGWIN__) +# undef TclpGetPid +# define TclpGetPid(pid) ((unsigned long) (pid)) #endif #endif /* _TCLINTPLATDECLS */ 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 d5cc6e1..821befd 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -123,6 +123,16 @@ static const DeclaredClassMethod objMethods[] = { }; /* + * And for the oo::class constructor... + */ + +static const Tcl_MethodType classConstructor = { + TCL_OO_METHOD_VERSION_CURRENT, + "oo::class constructor", + TclOO_Class_Constructor, NULL, NULL +}; + +/* * Scripted parts of TclOO. First, the master script (cannot be outside this * file). */ @@ -135,18 +145,6 @@ static const char *initScript = /* " tcloo.tcl OO_LIBRARY oo::library;"; */ /* - * The body of the constructor for oo::class. - */ - -static const char *classConstructorBody = -"set script [list ::oo::define [self] $definitionScript];" -"lassign [::oo::UpCatch $script] msg opts;" -"if {[dict get $opts -code] == 1} {" -" dict set opts -errorline 0xDeadBeef" -"};" -"return -options $opts $msg;"; - -/* * The scripted part of the definitions of slots. */ @@ -340,12 +338,12 @@ InitFoundation( TclNewLiteralStringObj(fPtr->constructorName, "<constructor>"); TclNewLiteralStringObj(fPtr->destructorName, "<destructor>"); TclNewLiteralStringObj(fPtr->clonedName, "<cloned>"); + TclNewLiteralStringObj(fPtr->defineName, "::oo::define"); Tcl_IncrRefCount(fPtr->unknownMethodNameObj); Tcl_IncrRefCount(fPtr->constructorName); Tcl_IncrRefCount(fPtr->destructorName); Tcl_IncrRefCount(fPtr->clonedName); - Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd, - TclOONRUpcatch, NULL, NULL); + Tcl_IncrRefCount(fPtr->defineName); Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition", TclOOUnknownDefinition, NULL, NULL); TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition"); @@ -358,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); @@ -418,28 +416,19 @@ InitFoundation( bodyPtr = Tcl_NewStringObj(clonedBody, -1); TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr, bodyPtr, NULL); - Tcl_DecrRefCount(argsPtr); + TclDecrRefCount(argsPtr); /* * Finish setting up the class of classes by marking the 'new' method as * private; classes, unlike general objects, must have explicit names. We * also need to create the constructor for classes. - * - * The 0xDeadBeef is a special signal to the errorInfo logger that is used - * by constructors that stops it from generating extra error information - * that is confusing. */ TclNewLiteralStringObj(namePtr, "new"); Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr, namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL); - - TclNewLiteralStringObj(argsPtr, "{definitionScript {}}"); - Tcl_IncrRefCount(argsPtr); - bodyPtr = Tcl_NewStringObj(classConstructorBody, -1); - fPtr->classCls->constructorPtr = TclOONewProcMethod(interp, - fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL); - Tcl_DecrRefCount(argsPtr); + fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp, + (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL); /* * Create non-object commands and plug ourselves into the Tcl [info] @@ -529,10 +518,11 @@ KillFoundation( DelRef(fPtr->objectCls->thisPtr); DelRef(fPtr->objectCls); - Tcl_DecrRefCount(fPtr->unknownMethodNameObj); - Tcl_DecrRefCount(fPtr->constructorName); - Tcl_DecrRefCount(fPtr->destructorName); - Tcl_DecrRefCount(fPtr->clonedName); + TclDecrRefCount(fPtr->unknownMethodNameObj); + TclDecrRefCount(fPtr->constructorName); + TclDecrRefCount(fPtr->destructorName); + TclDecrRefCount(fPtr->clonedName); + TclDecrRefCount(fPtr->defineName); ckfree(fPtr); } @@ -667,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); @@ -789,7 +779,7 @@ ObjectRenamedTrace( if (flags & TCL_TRACE_RENAME) { if (oPtr->cachedNameObj) { - Tcl_DecrRefCount(oPtr->cachedNameObj); + TclDecrRefCount(oPtr->cachedNameObj); oPtr->cachedNameObj = NULL; } return; @@ -1044,7 +1034,7 @@ ReleaseClassContents( Tcl_Obj *filterObj; FOREACH(filterObj, clsPtr->filters) { - Tcl_DecrRefCount(filterObj); + TclDecrRefCount(filterObj); } ckfree(clsPtr->filters.list); clsPtr->filters.num = 0; @@ -1123,7 +1113,7 @@ ObjectNamespaceDeleted( } FOREACH(filterObj, oPtr->filters) { - Tcl_DecrRefCount(filterObj); + TclDecrRefCount(filterObj); } if (i) { ckfree(oPtr->filters.list); @@ -1138,7 +1128,7 @@ ObjectNamespaceDeleted( } FOREACH(variableObj, oPtr->variables) { - Tcl_DecrRefCount(variableObj); + TclDecrRefCount(variableObj); } if (i) { ckfree(oPtr->variables.list); @@ -1149,7 +1139,7 @@ ObjectNamespaceDeleted( } if (oPtr->cachedNameObj) { - Tcl_DecrRefCount(oPtr->cachedNameObj); + TclDecrRefCount(oPtr->cachedNameObj); oPtr->cachedNameObj = NULL; } @@ -1180,7 +1170,7 @@ ObjectNamespaceDeleted( } FOREACH(filterObj, clsPtr->filters) { - Tcl_DecrRefCount(filterObj); + TclDecrRefCount(filterObj); } if (i) { ckfree(clsPtr->filters.list); @@ -1225,7 +1215,7 @@ ObjectNamespaceDeleted( TclOODelMethodRef(clsPtr->destructorPtr); FOREACH(variableObj, clsPtr->variables) { - Tcl_DecrRefCount(variableObj); + TclDecrRefCount(variableObj); } if (i) { ckfree(clsPtr->variables.list); @@ -2490,7 +2480,7 @@ TclOOObjectCmdCore( result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr, (Tcl_Class *) startClsPtr, mappedMethodName); if (result != TCL_OK) { - Tcl_DecrRefCount(mappedMethodName); + TclDecrRefCount(mappedMethodName); if (result == TCL_BREAK) { goto noMapping; } else if (result == TCL_ERROR) { @@ -2506,7 +2496,7 @@ TclOOObjectCmdCore( Tcl_IncrRefCount(mappedMethodName); contextPtr = TclOOGetCallContext(oPtr, mappedMethodName, flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr); - Tcl_DecrRefCount(mappedMethodName); + TclDecrRefCount(mappedMethodName); if (contextPtr == NULL) { Tcl_AppendResult(interp, "impossible to invoke method \"", TclGetString(methodNamePtr), diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 329f0a4..35ad1eb 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -19,6 +19,8 @@ static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp); static int AfterNRDestructor(ClientData data[], Tcl_Interp *interp, int result); +static int DecrRefsPostClassConstructor(ClientData data[], + Tcl_Interp *interp, int result); static int FinalizeConstruction(ClientData data[], Tcl_Interp *interp, int result); static int FinalizeEval(ClientData data[], @@ -70,6 +72,74 @@ FinalizeConstruction( /* * ---------------------------------------------------------------------- * + * TclOO_Class_Constructor -- + * + * Implementation for oo::class constructor. + * + * ---------------------------------------------------------------------- + */ + +int +TclOO_Class_Constructor( + ClientData clientData, + Tcl_Interp *interp, + Tcl_ObjectContext context, + int objc, + Tcl_Obj *const *objv) +{ + Object *oPtr = (Object *) Tcl_ObjectContextObject(context); + Tcl_Obj *invoke[3]; + + if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) { + Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, + "?definitionScript?"); + return TCL_ERROR; + } else if (objc == Tcl_ObjectContextSkippedArgs(context)) { + return TCL_OK; + } + + /* + * Delegate to [oo::define] to do the work. + */ + + invoke[0] = oPtr->fPtr->defineName; + invoke[1] = TclOOObjectName(interp, oPtr); + invoke[2] = objv[objc-1]; + + /* + * Must add references or errors in configuration script will cause + * trouble. + */ + + Tcl_IncrRefCount(invoke[0]); + Tcl_IncrRefCount(invoke[1]); + Tcl_IncrRefCount(invoke[2]); + TclNRAddCallback(interp, DecrRefsPostClassConstructor, + invoke[0], invoke[1], invoke[2], NULL); + + /* + * Tricky point: do not want the extra reported level in the Tcl stack + * trace, so use TCL_EVAL_NOERR. + */ + + return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL); +} + +static int +DecrRefsPostClassConstructor( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + TclDecrRefCount((Tcl_Obj *) data[0]); + TclDecrRefCount((Tcl_Obj *) data[1]); + TclDecrRefCount((Tcl_Obj *) data[2]); + return result; +} + +/* + * ---------------------------------------------------------------------- + * * TclOO_Class_Create -- * * Implementation for oo::class->create method. @@ -1120,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); } @@ -1141,74 +1211,6 @@ TclOOCopyObjectCmd( } /* - * ---------------------------------------------------------------------- - * - * TclOOUpcatchCmd -- - * - * Implementation of the [oo::UpCatch] command, which is a combination of - * [uplevel 1] and [catch] that makes it easier to write transparent - * error handling in scripts. - * - * ---------------------------------------------------------------------- - */ - -int -TclOOUpcatchCmd( - ClientData ignored, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - return Tcl_NRCallObjProc(interp, TclOONRUpcatch, NULL, objc, objv); -} - -static int -UpcatchCallback( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - Interp *iPtr = (Interp *) interp; - CallFrame *savedFramePtr = data[0]; - Tcl_Obj *resultObj[2]; - int rewind = iPtr->execEnvPtr->rewind; - - iPtr->varFramePtr = savedFramePtr; - if (rewind || Tcl_LimitExceeded(interp)) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp))); - return TCL_ERROR; - } - resultObj[0] = Tcl_GetObjResult(interp); - resultObj[1] = Tcl_GetReturnOptions(interp, result); - Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj)); - return TCL_OK; -} - -int -TclOONRUpcatch( - ClientData ignored, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Interp *iPtr = (Interp *) interp; - CallFrame *savedFramePtr = iPtr->varFramePtr; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "script"); - return TCL_ERROR; - } - if (iPtr->varFramePtr->callerVarPtr != NULL) { - iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr; - } - - Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL); - return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR, - iPtr->cmdFramePtr, 1); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 3d72690..69cffb0 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -17,6 +17,13 @@ #include "tclOOInt.h" /* + * The maximum length of fully-qualified object name to use in an errorinfo + * message. Longer than this will be curtailed. + */ + +#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30 + +/* * Some things that make it easier to declare a slot. */ @@ -40,6 +47,8 @@ struct DeclaredSlot { static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr); static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr); +static void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr, + Tcl_Obj *savedNameObj, const char *typeOfSubject); static inline Class * GetClassInOuterContext(Tcl_Interp *interp, Tcl_Obj *className, const char *errMsg); static inline int InitDefineContext(Tcl_Interp *interp, @@ -673,6 +682,7 @@ TclOOGetDefineCmdContext( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; + Tcl_Object object; if ((iPtr->varFramePtr == NULL) || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) { @@ -682,7 +692,14 @@ TclOOGetDefineCmdContext( Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } - return (Tcl_Object) iPtr->varFramePtr->clientData; + object = iPtr->varFramePtr->clientData; + if (Tcl_ObjectDeleted(object)) { + Tcl_AppendResult(interp, "this command cannot be called when the " + "object has been deleted", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + return NULL; + } + return object; } /* @@ -730,6 +747,44 @@ GetClassInOuterContext( /* * ---------------------------------------------------------------------- * + * GenerateErrorInfo -- + * Factored out code to generate part of the error trace messages. + * + * ---------------------------------------------------------------------- + */ + +static void +GenerateErrorInfo( + Tcl_Interp *interp, /* Where to store the error info trace. */ + Object *oPtr, /* What object (or class) was being configured + * when the error occurred? */ + Tcl_Obj *savedNameObj, /* Name of object saved from before script was + * evaluated, which is needed if the object + * goes away part way through execution. OTOH, + * if the object isn't deleted then its + * current name (post-execution) has to be + * used. This matters, because the object + * could have been renamed... */ + const char *typeOfSubject) /* Part of the message, saying whether it was + * an object, class or class-as-object that + * was being configured. */ +{ + int length; + Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) + ? savedNameObj : TclOOObjectName(interp, oPtr); + const char *objName = Tcl_GetStringFromObj(realNameObj, &length); + int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; + int overflow = (length > limit); + + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (in definition script for %s \"%.*s%s\" line %d)", + typeOfSubject, (overflow ? limit : length), objName, + (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); +} + +/* + * ---------------------------------------------------------------------- + * * TclOODefineObjCmd -- * Implementation of the "oo::define" command. Works by effectively doing * the same as 'namespace eval', but with extra magic applied so that the @@ -779,20 +834,15 @@ TclOODefineObjCmd( AddRef(oPtr); if (objc == 3) { + Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); + + Tcl_IncrRefCount(objNameObj); result = TclEvalObjEx(interp, objv[2], 0, ((Interp *)interp)->cmdFramePtr, 2); - if (result == TCL_ERROR) { - int length; - const char *objName = Tcl_GetStringFromObj(objv[1], &length); - int limit = 60; - int overflow = (length > limit); - - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (in definition script for object \"%.*s%s\" line %d)", - (overflow ? limit : length), objName, - (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); + GenerateErrorInfo(interp, oPtr, objNameObj, "class"); } + TclDecrRefCount(objNameObj); } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; Interp *iPtr = (Interp *) interp; @@ -898,20 +948,15 @@ TclOOObjDefObjCmd( AddRef(oPtr); if (objc == 3) { + Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); + + Tcl_IncrRefCount(objNameObj); result = TclEvalObjEx(interp, objv[2], 0, ((Interp *)interp)->cmdFramePtr, 2); - if (result == TCL_ERROR) { - int length; - const char *objName = Tcl_GetStringFromObj(objv[1], &length); - int limit = 60; - int overflow = (length > limit); - - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (in definition script for object \"%.*s%s\" line %d)", - (overflow ? limit : length), objName, - (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); + GenerateErrorInfo(interp, oPtr, objNameObj, "object"); } + TclDecrRefCount(objNameObj); } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; Interp *iPtr = (Interp *) interp; @@ -1017,21 +1062,15 @@ TclOODefineSelfObjCmd( AddRef(oPtr); if (objc == 2) { + Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr); + + Tcl_IncrRefCount(objNameObj); result = TclEvalObjEx(interp, objv[1], 0, ((Interp *)interp)->cmdFramePtr, 2); - if (result == TCL_ERROR) { - int length; - const char *objName = Tcl_GetStringFromObj( - TclOOObjectName(interp, oPtr), &length); - int limit = 60; - int overflow = (length > limit); - - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (in definition script for object \"%.*s%s\" line %d)", - (overflow ? limit : length), objName, - (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); + GenerateErrorInfo(interp, oPtr, objNameObj, "class object"); } + TclDecrRefCount(objNameObj); } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; Interp *iPtr = (Interp *) interp; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 7988452..631961f 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -322,6 +322,7 @@ typedef struct Foundation { * destructor. */ Tcl_Obj *clonedName; /* Shared object containing the name of a * "<cloned>" pseudo-constructor. */ + Tcl_Obj *defineName; /* Fully qualified name of oo::define. */ } Foundation; /* @@ -453,6 +454,9 @@ MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, * Method implementations (in tclOOBasic.c). */ +MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData, + Tcl_Interp *interp, Tcl_ObjectContext context, + int objc, Tcl_Obj *const *objv); MODULE_SCOPE int TclOO_Class_Create(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); @@ -519,8 +523,6 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_Obj *const *objv, int skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); -MODULE_SCOPE int TclOONRUpcatch(ClientData ignored, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr, @@ -532,9 +534,6 @@ MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp, MODULE_SCOPE void TclOOStashContext(Tcl_Obj *objPtr, CallContext *contextPtr); MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); -MODULE_SCOPE int TclOOUpcatchCmd(ClientData ignored, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); /* * Include all the private API, generated from tclOO.decls. diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 4e7edb8..877c3db 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1204,15 +1204,6 @@ ConstructorErrorHandler( const char *objectName, *kindName; int objectNameLen; - if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) { - /* - * Horrible hack to deal with certain constructors that must not add - * information to the error trace. - */ - - return; - } - if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 84a9136..b87a8df 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -102,24 +102,23 @@ Tcl_PanicVA( arg8); fprintf(stderr, "\n"); fflush(stderr); - } - /* In case the users panic proc does not abort, we do it here */ #if defined(_WIN32) || defined(__CYGWIN__) # if defined(__GNUC__) - __builtin_trap(); + __builtin_trap(); # elif defined(_WIN64) - __debugbreak(); + __debugbreak(); # elif defined(_MSC_VER) - _asm {int 3} + _asm {int 3} # else - DebugBreak(); + DebugBreak(); # endif #endif #if defined(_WIN32) - ExitProcess(1); + ExitProcess(1); #else - abort(); + abort(); #endif + } } /* diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 4f86755..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 @@ -92,9 +94,7 @@ typedef struct FsPath { * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ - struct FilesystemRecord *fsRecPtr; - /* Pointer to the filesystem record entry to - * use for this path. */ + const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */ } FsPath; /* @@ -152,14 +152,8 @@ typedef struct FsPath { Tcl_Obj * TclFSNormalizeAbsolutePath( Tcl_Interp *interp, /* Interpreter to use */ - Tcl_Obj *pathPtr, /* Absolute path to normalize */ - ClientData *clientDataPtr) /* If non-NULL, then may be set to the - * fs-specific clientData for this path. This - * will happen when that extra information can - * be calculated efficiently as a side-effect - * of normalization. */ + Tcl_Obj *pathPtr) /* Absolute path to normalize */ { - ClientData clientData = NULL; const char *dirSep, *oldDirSep; int first = 1; /* Set to zero once we've passed the first * directory separator - we can't use '..' to @@ -433,17 +427,14 @@ TclFSNormalizeAbsolutePath( * for normalizing a path. */ - TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); + TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can actually convert this * object into an FsPath for greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal, clientData); - if (clientDataPtr != NULL) { - *clientDataPtr = clientData; - } + MakePathFromNormalized(interp, retVal); /* * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs. @@ -575,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: { /* @@ -1087,7 +1077,7 @@ TclJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - length++; + Tcl_GetStringFromObj(res, &length); } Tcl_SetObjLength(res, length + (int) strlen(strElt)); @@ -1274,7 +1264,6 @@ TclNewFSPathObj( { FsPath *fsPathPtr; Tcl_Obj *pathPtr; - ThreadSpecificData *tsdPtr; const char *p; int state = 0, count = 0; @@ -1302,8 +1291,6 @@ TclNewFSPathObj( return pathPtr; } - tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - pathPtr = Tcl_NewObj(); fsPathPtr = ckalloc(sizeof(FsPath)); @@ -1317,8 +1304,8 @@ TclNewFSPathObj( fsPathPtr->cwdPtr = dirPtr; Tcl_IncrRefCount(dirPtr); fsPathPtr->nativePathPtr = NULL; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = NULL; + fsPathPtr->filesystemEpoch = 0; SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = TCLPATH_APPENDED; @@ -1428,8 +1415,7 @@ TclFSMakePathRelative( if (pathPtr->typePtr == &tclFsPathType) { FsPath *fsPathPtr = PATHOBJ(pathPtr); - if (PATHFLAGS(pathPtr) != 0 - && fsPathPtr->cwdPtr == cwdPtr) { + if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { return fsPathPtr->normPathPtr; } } @@ -1473,7 +1459,7 @@ TclFSMakePathRelative( /* *--------------------------------------------------------------------------- * - * TclFSMakePathFromNormalized -- + * MakePathFromNormalized -- * * Like SetFsPathFromAny, but assumes the given object is an absolute * normalized path. Only for internal use. @@ -1487,15 +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. */ - ClientData nativeRep) /* The native rep for the object, if known - * else NULL. */ + Tcl_Obj *pathPtr) /* The object to convert. */ { FsPath *fsPathPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -1536,9 +1519,10 @@ TclFSMakePathFromNormalized( fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; - fsPathPtr->nativePathPtr = nativeRep; - fsPathPtr->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->nativePathPtr = NULL; + fsPathPtr->fsPtr = NULL; + /* Remember the epoch under which we decided pathPtr was normalized */ + fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; @@ -1577,14 +1561,13 @@ Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData) { - Tcl_Obj *pathPtr; + Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - FilesystemRecord *fsFromPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, - &fsFromPtr); + if (fromFilesystem->internalToNormalizedProc != NULL) { + pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); + } if (pathPtr == NULL) { return NULL; } @@ -1615,9 +1598,8 @@ Tcl_FSNewNativePath( fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; - fsPathPtr->fsRecPtr = fsFromPtr; - fsPathPtr->fsRecPtr->fileRefCount++; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = fromFilesystem; + fsPathPtr->filesystemEpoch = TclFSEpoch(); SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; @@ -1675,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 { @@ -1778,7 +1766,6 @@ Tcl_FSGetNormalizedPath( Tcl_Obj *dir, *copy; int cwdLen, pathType; - ClientData clientData = NULL; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); @@ -1811,7 +1798,7 @@ Tcl_FSGetNormalizedPath( * 2385549] ... */ - Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL); + Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); Tcl_DecrRefCount(copy); copy = newCopy; @@ -1826,8 +1813,7 @@ Tcl_FSGetNormalizedPath( * will actually start off directly after that separator. */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); } /* Now we need to construct the new path object. */ @@ -1870,15 +1856,6 @@ Tcl_FSGetNormalizedPath( TclDecrRefCount(dir); } - if (clientData != NULL) { - /* - * This may be unnecessary. It appears that the - * TclFSNormalizeToUniquePath call above should have already set - * this up. Not changing out of fear of the unknown. - */ - - fsPathPtr->nativePathPtr = clientData; - } PATHFLAGS(pathPtr) = 0; } @@ -1899,7 +1876,6 @@ Tcl_FSGetNormalizedPath( } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; - ClientData clientData = NULL; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); @@ -1911,17 +1887,12 @@ Tcl_FSGetNormalizedPath( * of the previously normalized 'dir'. This should be much faster! */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; Tcl_IncrRefCount(fsPathPtr->normPathPtr); - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } } } if (fsPathPtr->normPathPtr == NULL) { - ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; int pureNormalized = 1; @@ -2003,12 +1974,7 @@ Tcl_FSGetNormalizedPath( */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, - absolutePath, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); - if (0 && (clientData != NULL)) { - fsPathPtr->nativePathPtr = - fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc(clientData); - } + absolutePath); /* * Check if path is pure normalized (this can only be the case if it @@ -2099,7 +2065,7 @@ Tcl_FSGetInternalRep( * not easily achievable with the current implementation. */ - if (srcFsPathPtr->fsRecPtr == NULL) { + if (srcFsPathPtr->fsPtr == NULL) { /* * This only usually happens in wrappers like TclpStat which create a * string object and pass it to TclpObjStat. Code which calls the @@ -2119,7 +2085,7 @@ Tcl_FSGetInternalRep( */ srcFsPathPtr = PATHOBJ(pathPtr); - if (srcFsPathPtr->fsRecPtr == NULL) { + if (srcFsPathPtr->fsPtr == NULL) { return NULL; } } @@ -2131,7 +2097,7 @@ Tcl_FSGetInternalRep( * for this is we ask what filesystem this path belongs to. */ - if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { + if (fsPtr != srcFsPathPtr->fsPtr) { const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); if (actualFs == fsPtr) { @@ -2144,7 +2110,7 @@ Tcl_FSGetInternalRep( Tcl_FSCreateInternalRepProc *proc; char *nativePathPtr; - proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc; + proc = srcFsPathPtr->fsPtr->createInternalRepProc; if (proc == NULL) { return NULL; } @@ -2212,8 +2178,8 @@ TclFSEnsureEpochOk( * Check whether the object is already assigned to a fs. */ - if (srcFsPathPtr->fsRecPtr != NULL) { - *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr; + if (srcFsPathPtr->fsPtr != NULL) { + *fsPtrPtr = srcFsPathPtr->fsPtr; } return TCL_OK; } @@ -2237,10 +2203,9 @@ TclFSEnsureEpochOk( void TclFSSetPathDetails( Tcl_Obj *pathPtr, - FilesystemRecord *fsRecPtr, + const Tcl_Filesystem *fsPtr, ClientData clientData) { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); FsPath *srcFsPathPtr; /* @@ -2254,10 +2219,9 @@ TclFSSetPathDetails( } srcFsPathPtr = PATHOBJ(pathPtr); - srcFsPathPtr->fsRecPtr = fsRecPtr; + srcFsPathPtr->fsPtr = fsPtr; srcFsPathPtr->nativePathPtr = clientData; - srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - fsRecPtr->fileRefCount++; + srcFsPathPtr->filesystemEpoch = TclFSEpoch(); } /* @@ -2346,7 +2310,6 @@ SetFsPathFromAny( FsPath *fsPathPtr; Tcl_Obj *transPtr; char *name; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; @@ -2500,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->fsRecPtr = NULL; - fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; + fsPathPtr->fsPtr = NULL; /* * Free old representation before installing our new one. @@ -2538,25 +2504,15 @@ FreeFsPathInternalRep( if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); } - if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) { + if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = - fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc; + fsPathPtr->fsPtr->freeInternalRepProc; if (freeProc != NULL) { freeProc(fsPathPtr->nativePathPtr); fsPathPtr->nativePathPtr = NULL; } } - if (fsPathPtr->fsRecPtr != NULL) { - fsPathPtr->fsRecPtr->fileRefCount--; - if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { - /* - * It has been unregistered already. - */ - - ckfree(fsPathPtr->fsRecPtr); - } - } ckfree(fsPathPtr); pathPtr->typePtr = NULL; @@ -2599,10 +2555,10 @@ DupFsPathInternalRep( copyFsPathPtr->flags = srcFsPathPtr->flags; - if (srcFsPathPtr->fsRecPtr != NULL + if (srcFsPathPtr->fsPtr != NULL && srcFsPathPtr->nativePathPtr != NULL) { Tcl_FSDupInternalRepProc *dupProc = - srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc; + srcFsPathPtr->fsPtr->dupInternalRepProc; if (dupProc != NULL) { copyFsPathPtr->nativePathPtr = @@ -2613,11 +2569,8 @@ DupFsPathInternalRep( } else { copyFsPathPtr->nativePathPtr = NULL; } - copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; + copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - if (copyFsPathPtr->fsRecPtr != NULL) { - copyFsPathPtr->fsRecPtr->fileRefCount++; - } copyPtr->typePtr = &tclFsPathType; } 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/tclPlatDecls.h b/generic/tclPlatDecls.h index 37f5479..48ad390 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -31,7 +31,7 @@ * TCHAR is needed here for win32, so if it is not defined yet do it here. * This way, we don't need to include <tchar.h> just for one define. */ -#if defined(_WIN32) && !defined(_TCHAR_DEFINED) +#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED) # if defined(_UNICODE) typedef wchar_t TCHAR; # else @@ -46,19 +46,7 @@ * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -/* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath); -/* 1 */ -EXTERN int Tcl_MacOSXOpenVersionedBundleResources( - Tcl_Interp *interp, const char *bundleName, - const char *bundleVersion, - int hasResourceFile, int maxPathLen, - char *libraryPath); -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); @@ -83,11 +71,7 @@ typedef struct TclPlatStubs { int magic; const struct TclPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ #endif /* WIN */ @@ -111,13 +95,7 @@ extern const TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ -#define Tcl_MacOSXOpenVersionedBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ diff --git a/generic/tclPort.h b/generic/tclPort.h index 79bea88..7021b8d 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -25,19 +25,6 @@ # include "tclUnixPort.h" #endif -#if defined(__CYGWIN__) -# define USE_PUTENV 1 -# define USE_PUTENV_FOR_UNSET 1 -/* On Cygwin, the environment is imported from the Cygwin DLL. */ -# define environ __cygwin_environ -# define timezone _timezone - DLLIMPORT extern char **__cygwin_environ; - DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *); - DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value); - DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value); - DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *); -#endif - #if !defined(LLONG_MIN) # ifdef TCL_WIDE_INT_IS_LONG # define LLONG_MIN LONG_MIN diff --git a/generic/tclProc.c b/generic/tclProc.c index d008217..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); @@ -2234,7 +2234,7 @@ TclProcCleanupProc( * procbody structures created by tbcload. */ - if (!iPtr) { + if (iPtr == NULL) { return; } @@ -2245,13 +2245,15 @@ TclProcCleanupProc( cfPtr = Tcl_GetHashValue(hePtr); - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); - cfPtr->data.eval.path = NULL; + if (cfPtr) { + if (cfPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(cfPtr->data.eval.path); + cfPtr->data.eval.path = NULL; + } + ckfree(cfPtr->line); + cfPtr->line = NULL; + ckfree(cfPtr); } - ckfree(cfPtr->line); - cfPtr->line = NULL; - ckfree(cfPtr); Tcl_DeleteHashEntry(hePtr); } @@ -2483,7 +2485,8 @@ SetLambdaFromAny( Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; - int objc, result; + int isNew, objc, result; + CmdFrame *cfPtr = NULL; Proc *procPtr; if (interp == NULL) { @@ -2578,14 +2581,14 @@ SetLambdaFromAny( if (contextPtr->line && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) { - int isNew, buf[2]; - CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); + int buf[2]; /* * Move from approximation (line of list cmd word) to actual * location (line of 2nd list element). */ + cfPtr = ckalloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; @@ -2601,9 +2604,6 @@ SetLambdaFromAny( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, - procPtr, &isNew), cfPtr); } /* @@ -2615,6 +2615,8 @@ SetLambdaFromAny( } TclStackFree(interp, contextPtr); } + Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, + &isNew), cfPtr); /* * Set the namespace for this lambda: given by objv[2] understood as a diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 332cfca..2d534a68 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -192,8 +192,6 @@ static int maxDigits; /* The maximum number of digits to the left of * the decimal point of a double. */ static int minDigits; /* The maximum number of digits to the right * of the decimal point in a double. */ -static int mantDIGIT; /* Number of mp_digit's needed to hold the - * significand of a double. */ static const double pow_10_2_n[] = { /* Inexact higher powers of ten. */ 1.0, 100.0, @@ -4425,7 +4423,6 @@ TclInitDoubleConversion(void) + 0.5 * log(10.)) / log(10.)); minDigits = (int) floor((DBL_MIN_EXP - DBL_MANT_DIG) * log((double) FLT_RADIX) / log(10.)); - mantDIGIT = (mantBits + DIGIT_BIT-1) / DIGIT_BIT; log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.)); /* diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 3a7a6d4..87cd4eb 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -53,32 +53,27 @@ static int TclSockMinimumBuffersOld(int sock, int size) } #endif -#ifdef __CYGWIN__ - -/* Trick, so we don't have to include <windows.h> here, which - * - b.t.w. - lacks this function anyway */ -#define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 -int __stdcall GetModuleHandleExW(unsigned int, const char *, void *); - -#define TclWinGetPlatformId winGetPlatformId -#define Tcl_WinUtfToTChar winUtfToTChar -#define Tcl_WinTCharToUtf winTCharToUtf -#define TclWinGetTclInstance winGetTclInstance -#define TclWinNToHS winNToHS -#define TclWinSetSockOpt winSetSockOpt -#define TclWinGetSockOpt winGetSockOpt -#define TclWinGetServByName winGetServByName -#define TclWinNoBackslash winNoBackslash -#define TclWinSetInterfaces (void (*) (int)) doNothing -#define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing -#define TclIntPlatReserved13 (void (*) ()) TclpCreateCommandChannel -#define TclWinFlushDirtyChannels doNothing -#define TclWinResetInterfaces doNothing -#define TclpGetPid getPid +#ifdef __WIN32__ +# define TclUnixWaitForFile 0 +# define TclUnixCopyFile 0 +# define TclpReaddir 0 +# define TclpIsAtty 0 +#elif defined(__CYGWIN__) +# define TclpIsAtty TclPlatIsAtty +# define TclWinSetInterfaces (void (*) (int)) doNothing +# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing +# define TclWinFlushDirtyChannels doNothing +# define TclWinResetInterfaces doNothing static Tcl_Encoding winTCharEncoding; static int +TclpIsAtty(int fd) +{ + return isatty(fd); +} + +int TclWinGetPlatformId() { /* Don't bother to determine the real platform on cygwin, @@ -86,7 +81,7 @@ TclWinGetPlatformId() return 2; /* VER_PLATFORM_WIN32_NT */; } -static void *TclWinGetTclInstance() +void *TclWinGetTclInstance() { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, @@ -94,21 +89,21 @@ static void *TclWinGetTclInstance() return hInstance; } -static unsigned short +unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } -static int -TclWinSetSockOpt(void *s, int level, int optname, +int +TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt((int) s, level, optname, optval, optlen); } -static int -TclWinGetSockOpt(void *s, int level, int optname, +int +TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen) { return getsockopt((int) s, level, optname, optval, optlen); @@ -120,7 +115,7 @@ TclWinGetServByName(const char *name, const char *proto) return getservbyname(name, proto); } -static char * +char * TclWinNoBackslash(char *path) { char *p; @@ -133,7 +128,7 @@ TclWinNoBackslash(char *path) return path; } -static int +int TclpGetPid(Tcl_Pid pid) { return (int) (size_t) pid; @@ -145,11 +140,11 @@ doNothing(void) /* dummy implementation, no need to do anything */ } -static char * -Tcl_WinUtfToTChar(string, len, dsPtr) - const char *string; - int len; - Tcl_DString *dsPtr; +char * +Tcl_WinUtfToTChar( + const char *string, + int len, + Tcl_DString *dsPtr) { if (!winTCharEncoding) { winTCharEncoding = Tcl_GetEncoding(0, "unicode"); @@ -158,7 +153,7 @@ Tcl_WinUtfToTChar(string, len, dsPtr) string, len, dsPtr); } -static char * +char * Tcl_WinTCharToUtf( const char *string, int len, @@ -171,42 +166,15 @@ Tcl_WinTCharToUtf( string, len, dsPtr); } -#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \ - Tcl_Interp *, const char *, int, int, char *))) Tcl_WinUtfToTChar -#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \ - Tcl_Interp *, const char *, const char *, int, int, char *))) Tcl_WinTCharToUtf -#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *, \ - int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess -#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, const char *, \ - const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile -#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((const void *))) TclpOpenFile -#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclGetAndDetachPids -#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclpCloseFile +#define TclMacOSXGetFileAttribute (int (*) (Tcl_Interp *, \ + int, Tcl_Obj *, Tcl_Obj **)) TclpCreateProcess +#define TclMacOSXMatchType (int (*) (Tcl_Interp *, const char *, \ + const char *, Tcl_StatBuf *, Tcl_GlobTypeData *)) TclpMakeFile +#define TclMacOSXNotifierAddRunLoopMode (void (*) (const void *)) TclpOpenFile +#define TclpLocaltime_unix (struct tm *(*) (const time_t *)) TclGetAndDetachPids +#define TclpGmtime_unix (struct tm *(*) (const time_t *)) TclpCloseFile -#elif !defined(__WIN32__) /* UNIX and MAC */ -# define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids -# undef TclWinConvertWSAError -# define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile -# define TclWinGetPlatformId (int (*)()) TclpCreateTempFile -# define TclWinGetTclInstance (void *(*)()) TclpCreateProcess -# define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile -# define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, const char *, int))) TclpOpenFile -# define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int))) TclpCreatePipe -# define TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel -# define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa -# define TclWinAddProcess 0 -# define TclWinNoBackslash 0 -# define TclWinSetInterfaces 0 -# define TclWinFlushDirtyChannels 0 -# define TclWinResetInterfaces 0 -# define TclpGetPid 0 -# define TclMacOSXGetFileAttribute 0 /* Only implemented in Tcl >= 8.5 */ -# define TclMacOSXMatchType 0 /* Only implemented in Tcl >= 8.5 */ -# define TclMacOSXNotifierAddRunLoopMode 0 /* Only implemented in Tcl >= 8.5 */ -# ifndef MAC_OSX_TCL -# define Tcl_MacOSXOpenBundleResources 0 -# define Tcl_MacOSXOpenVersionedBundleResources 0 -# endif +#else /* UNIX and MAC */ # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime #endif @@ -481,70 +449,61 @@ static const TclIntStubs tclIntStubs = { static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ - TclWinGetTclInstance, /* 4 */ +#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + TclGetAndDetachPids, /* 0 */ + TclpCloseFile, /* 1 */ + TclpCreateCommandChannel, /* 2 */ + TclpCreatePipe, /* 3 */ + TclpCreateProcess, /* 4 */ 0, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ - TclpGetPid, /* 8 */ - TclWinGetPlatformId, /* 9 */ + TclpMakeFile, /* 6 */ + TclpOpenFile, /* 7 */ + TclUnixWaitForFile, /* 8 */ + TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ - TclIntPlatReserved13, /* 13 */ + TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ - TclMacOSXGetFileAttribute, /* 15 */ + 0, /* 15 */ 0, /* 16 */ 0, /* 17 */ - TclMacOSXMatchType, /* 18 */ - TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclWinAddProcess, /* 20 */ + 0, /* 18 */ + 0, /* 19 */ + 0, /* 20 */ 0, /* 21 */ - TclpCreateTempFile, /* 22 */ + 0, /* 22 */ 0, /* 23 */ - TclWinNoBackslash, /* 24 */ + 0, /* 24 */ 0, /* 25 */ - TclWinSetInterfaces, /* 26 */ - TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + 0, /* 26 */ + 0, /* 27 */ + 0, /* 28 */ TclWinCPUID, /* 29 */ - TclGetAndDetachPids, /* 30 */ - TclpCloseFile, /* 31 */ - TclpCreateCommandChannel, /* 32 */ - TclpCreatePipe, /* 33 */ - TclpCreateProcess, /* 34 */ - TclpInetNtoa, /* 35 */ - TclpMakeFile, /* 36 */ - TclpOpenFile, /* 37 */ - TclUnixWaitForFile, /* 38 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ TclWinConvertWSAError, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ - 0, /* 5 */ + TclUnixWaitForFile, /* 5 */ TclWinNToHS, /* 6 */ TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ - 0, /* 10 */ + TclpReaddir, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ - 0, /* 16 */ - 0, /* 17 */ + TclpIsAtty, /* 16 */ + TclUnixCopyFile, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - 0, /* 21 */ + TclpInetNtoa, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ @@ -555,56 +514,43 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclWinCPUID, /* 29 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ - TclWinGetTclInstance, /* 4 */ + TclGetAndDetachPids, /* 0 */ + TclpCloseFile, /* 1 */ + TclpCreateCommandChannel, /* 2 */ + TclpCreatePipe, /* 3 */ + TclpCreateProcess, /* 4 */ 0, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ - TclpGetPid, /* 8 */ - TclWinGetPlatformId, /* 9 */ + TclpMakeFile, /* 6 */ + TclpOpenFile, /* 7 */ + TclUnixWaitForFile, /* 8 */ + TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ - TclIntPlatReserved13, /* 13 */ + TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclWinAddProcess, /* 20 */ + 0, /* 20 */ 0, /* 21 */ - TclpCreateTempFile, /* 22 */ + 0, /* 22 */ 0, /* 23 */ - TclWinNoBackslash, /* 24 */ + 0, /* 24 */ 0, /* 25 */ - TclWinSetInterfaces, /* 26 */ - TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + 0, /* 26 */ + 0, /* 27 */ + 0, /* 28 */ TclWinCPUID, /* 29 */ - TclGetAndDetachPids, /* 30 */ - TclpCloseFile, /* 31 */ - TclpCreateCommandChannel, /* 32 */ - TclpCreatePipe, /* 33 */ - TclpCreateProcess, /* 34 */ - TclpInetNtoa, /* 35 */ - TclpMakeFile, /* 36 */ - TclpOpenFile, /* 37 */ - TclUnixWaitForFile, /* 38 */ #endif /* MACOSX */ }; static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ - Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ #endif /* WIN */ @@ -704,7 +650,7 @@ const TclStubs tclStubs = { #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_CreateFileHandler, /* 9 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) /* WIN */ 0, /* 9 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -713,7 +659,7 @@ const TclStubs tclStubs = { #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) /* WIN */ 0, /* 10 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -878,7 +824,7 @@ const TclStubs tclStubs = { #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_GetOpenFile, /* 167 */ #endif /* UNIX */ -#ifdef __WIN32__ /* WIN */ +#if defined(__WIN32__) /* WIN */ 0, /* 167 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 01e6cb4..5337b99 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -412,6 +412,11 @@ static int TestNRELevels(ClientData clientData, static int TestInterpResolverCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#if defined(HAVE_CPUID) || defined(__WIN32__) +static int TestcpuidCmd(ClientData dummy, + Tcl_Interp* interp, int objc, + Tcl_Obj *CONST objv[]); +#endif static const Tcl_Filesystem testReportingFilesystem = { "reporting", @@ -669,6 +674,10 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); +#if defined(HAVE_CPUID) || defined(__WIN32__) + Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, + (ClientData) 0, NULL); +#endif t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, @@ -3255,7 +3264,7 @@ TestlocaleCmd( "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; - static CONST int lcTypes[] = { + static const int lcTypes[] = { LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY, LC_ALL }; @@ -6635,6 +6644,62 @@ TestNumUtfCharsCmd( } return TCL_OK; } + +#if defined(HAVE_CPUID) || defined(__WIN32__) +/* + *---------------------------------------------------------------------- + * + * TestcpuidCmd -- + * + * Retrieves CPU ID information. + * + * Usage: + * testwincpuid <eax> + * + * Parameters: + * eax - The value to pass in the EAX register to a CPUID instruction. + * + * Results: + * Returns a four-element list containing the values from the EAX, EBX, + * ECX and EDX registers returned from the CPUID instruction. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestcpuidCmd( + ClientData dummy, + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ +{ + int status, index, i; + unsigned int regs[4]; + Tcl_Obj *regsObjs[4]; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "eax"); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) { + return TCL_ERROR; + } + status = TclWinCPUID((unsigned) index, regs); + if (status != TCL_OK) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("operation not available", -1)); + return status; + } + for (i=0 ; i<4 ; ++i) { + regsObjs[i] = Tcl_NewIntObj((int) regs[i]); + } + Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); + return TCL_OK; +} +#endif /* * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag diff --git a/generic/tclTimer.c b/generic/tclTimer.c index cf91dca..36adaad 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -182,8 +182,7 @@ static void TimerSetupProc(ClientData clientData, int flags); static ThreadSpecificData * InitTimer(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -214,8 +213,7 @@ static void TimerExitProc( ClientData clientData) /* Not used. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { @@ -297,9 +295,8 @@ TclCreateAbsoluteTimerHandler( ClientData clientData) { register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; - ThreadSpecificData *tsdPtr; + ThreadSpecificData *tsdPtr = InitTimer(); - tsdPtr = InitTimer(); timerHandlerPtr = ckalloc(sizeof(TimerHandler)); /* 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 1e35165..5c62cb7 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. @@ -2744,9 +2775,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, "{"); } } @@ -2772,7 +2803,7 @@ void Tcl_DStringEndSublist( Tcl_DString *dsPtr) /* Dynamic string. */ { - Tcl_DStringAppend(dsPtr, "}", -1); + TclDStringAppendLiteral(dsPtr, "}"); } /* @@ -3346,10 +3377,10 @@ static void UpdateStringOfEndOffset( register Tcl_Obj *objPtr) { - char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1]; + char buffer[TCL_INTEGER_SPACE + 5]; register int len; - memcpy(buffer, "end", sizeof("end") + 1); + memcpy(buffer, "end", 4); len = sizeof("end") - 1; if (objPtr->internalRep.longValue != 0) { buffer[len++] = '-'; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 3673833..a799639 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -17,6 +17,16 @@ #include "tclInt.h" #ifdef HAVE_ZLIB #include <zlib.h> +#include "tclIO.h" + +/* + * The version of the zlib "package" that this implements. Note that this + * thoroughly supersedes the versions included with tclkit, which are "1.1", + * so this is at least "2.0" (there's no general *commitment* to have the same + * interface, even if that is mostly true). + */ + +#define TCL_ZLIB_VERSION "2.0" /* * Magic flags used with wbits fields to indicate that we're handling the gzip @@ -90,6 +100,7 @@ typedef struct { GzipHeader outHeader; /* Header to write to an output stream, when * compressing a gzip stream. */ Tcl_TimerToken timer; /* Timer used for keeping events fresh. */ + Tcl_DString decompressed; /* Buffer for decompression results. */ } ZlibChannelData; /* @@ -112,13 +123,6 @@ typedef struct { #define DEFAULT_BUFFER_SIZE 4096 /* - * Time to wait (in milliseconds) before flushing the channel when reading - * data through the transform. - */ - -#define TRANSFORM_FLUSH_DELAY 5 - -/* * Prototypes for private procedures defined later in this file: */ @@ -127,7 +131,7 @@ static Tcl_DriverBlockModeProc ZlibTransformBlockMode; static Tcl_DriverCloseProc ZlibTransformClose; static Tcl_DriverGetHandleProc ZlibTransformGetHandle; static Tcl_DriverGetOptionProc ZlibTransformGetOption; -static Tcl_DriverHandlerProc ZlibTransformHandler; +static Tcl_DriverHandlerProc ZlibTransformEventHandler; static Tcl_DriverInputProc ZlibTransformInput; static Tcl_DriverOutputProc ZlibTransformOutput; static Tcl_DriverSetOptionProc ZlibTransformSetOption; @@ -139,13 +143,16 @@ static void ConvertError(Tcl_Interp *interp, int code); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); +static inline int ResultCopy(ZlibChannelData *cd, char *buf, + int toRead); +static int ResultGenerate(ZlibChannelData *cd, int n, int flush, + int *errorCodePtr); static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, int mode, int format, int level, Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr); static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr); -static void ZlibTransformTimerKill(ZlibChannelData *cd); +static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd); static void ZlibTransformTimerRun(ClientData clientData); -static void ZlibTransformTimerSetup(ZlibChannelData *cd); /* * Type of zlib-based compressing and decompressing channels. @@ -165,7 +172,7 @@ static const Tcl_ChannelType zlibChannelType = { NULL, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ - ZlibTransformHandler, + ZlibTransformEventHandler, NULL, /* wideSeekProc */ NULL, NULL @@ -539,6 +546,7 @@ Tcl_ZlibStreamInit( zshPtr->currentInput = NULL; zshPtr->streamEnd = 0; memset(&zshPtr->stream, 0, sizeof(z_stream)); + zshPtr->stream.adler = 1; /* * No output buffer available yet @@ -565,9 +573,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, @@ -2259,6 +2266,12 @@ ZlibStreamCmd( *---------------------------------------------------------------------- * Set of functions to support channel stacking. *---------------------------------------------------------------------- + * + * ZlibTransformClose -- + * + * How to shut down a stacked compressing/decompressing transform. + * + *---------------------------------------------------------------------- */ static int @@ -2273,7 +2286,7 @@ ZlibTransformClose( * Delete the support timer. */ - ZlibTransformTimerKill(cd); + ZlibTransformEventTimerKill(cd); /* * Flush any data waiting to be compressed. @@ -2320,6 +2333,8 @@ ZlibTransformClose( * Release all memory. */ + Tcl_DStringFree(&cd->decompressed); + if (cd->inBuffer) { ckfree(cd->inBuffer); cd->inBuffer = NULL; @@ -2331,6 +2346,16 @@ ZlibTransformClose( ckfree(cd); return result; } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformInput -- + * + * Reader filter that does decompression. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformInput( @@ -2342,78 +2367,144 @@ ZlibTransformInput( ZlibChannelData *cd = instanceData; Tcl_DriverInputProc *inProc = Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); - int e, readBytes, flush = Z_NO_FLUSH; + int readBytes, gotBytes, copied; if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead, errorCodePtr); } - cd->inStream.next_out = (Bytef *) buf; - cd->inStream.avail_out = toRead; - if (cd->inStream.next_in == NULL) { - goto doReadFirst; - } - while (1) { - e = inflate(&cd->inStream, flush); - if ((e == Z_STREAM_END) || (e==Z_OK && cd->inStream.avail_out==0)) { - return toRead - cd->inStream.avail_out; - } - + gotBytes = 0; + while (toRead > 0) { /* - * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html - * - * Just indicates that the zlib couldn't consume input/produce output, - * and is fixed by supplying more input. + * Loop until the request is satisfied (or no data available from + * below, possibly EOF). */ - if ((e != Z_OK) && (e != Z_BUF_ERROR)) { - Tcl_Obj *errObj = Tcl_NewListObj(0, NULL); + copied = ResultCopy(cd, buf, toRead); + toRead -= copied; + buf += copied; + gotBytes += copied; - Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->inStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); - *errorCodePtr = EINVAL; - return -1; + if (toRead == 0) { + return gotBytes; } /* - * Check if the inflate stopped early. + * The buffer is exhausted, but the caller wants even more. We now + * have to go to the underlying channel, get more bytes and then + * transform them for delivery. We may not get what we want (full EOF + * or temporarily out of data). + * + * Length (cd->decompressed) == 0, toRead > 0 here. + * + * The zlib transform allows us to read at most one character from the + * underlying channel to properly identify Z_STREAM_END without + * reading over the border. */ - if (cd->inStream.avail_in > 0) { - continue; - } - - /* - * Emptied the buffer of data from the underlying channel. Get some - * more. - */ + readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1); - doReadFirst: /* - * Hack for Bug 2762041. Disable pre-reading of lots of input, read - * only one character. This way the Z_END_OF_STREAM can be read - * without triggering an EOF in the base channel. The higher input - * loops in DoReadChars() would react to that by stopping, despite the - * transform still having data which could be read. - * - * This is only a hack because other transforms may not be able to - * work around the general problem in this way. + * Three cases here: + * 1. Got some data from the underlying channel (readBytes > 0) so + * it should be fed through the decompression engine. + * 2. Got an error (readBytes < 0) which we should report up except + * for the case where we can convert it to a short read. + * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If + * it is EOF, try flushing the data out of the decompressor. */ - readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1); if (readBytes < 0) { + /* + * Report errors to caller. The state of the seek system is + * unchanged! + */ + + if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) { + /* + * EAGAIN is a special situation. If we had some data before + * we report that instead of the request to re-try. + */ + + return gotBytes; + } + *errorCodePtr = Tcl_GetErrno(); return -1; } else if (readBytes == 0) { - flush = Z_SYNC_FLUSH; - } + /* + * Check wether we hit on EOF in 'parent' or not. If not, + * differentiate between blocking and non-blocking modes. In + * non-blocking mode we ran temporarily out of data. Signal this + * to the caller via EWOULDBLOCK and error return (-1). In the + * other cases we simply return what we got and let the caller + * wait for more. On the other hand, if we got an EOF we have to + * convert and flush all waiting partial data. + */ + + if (!Tcl_Eof(cd->parent)) { + /* + * The state of the seek system is unchanged! + */ + + if ((gotBytes == 0) && (cd->flags & ASYNC)) { + *errorCodePtr = EWOULDBLOCK; + return -1; + } + return gotBytes; + } - cd->inStream.next_in = (Bytef *) cd->inBuffer; - cd->inStream.avail_in = readBytes; + /* + * (Semi-)Eof in parent. + * + * Now this is a bit different. The partial data waiting is + * converted and returned. + */ + + if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) { + return -1; + } + + if (Tcl_DStringLength(&cd->decompressed) == 0) { + /* + * The drain delivered nothing. Time to deliver what we've + * got. + */ + + return gotBytes; + } + + /* + * Reset eof, force caller to drain result buffer. + */ + + ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF; + } else /* readBytes > 0 */ { + /* + * Transform the read chunk, which was not empty. Anything we get + * back is a transformation result to be put into our buffers, and + * the next iteration will put it into the result. + */ + + if (ResultGenerate(cd, readBytes, Z_NO_FLUSH, + errorCodePtr) != TCL_OK) { + return -1; + } + } } + return gotBytes; } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformOutput -- + * + * Writer filter that does compression. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformOutput( @@ -2458,6 +2549,16 @@ ZlibTransformOutput( return toWrite - cd->outStream.avail_in; } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformSetOption -- + * + * Writing side of [fconfigure] on our channel. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformSetOption( /* not used */ @@ -2508,7 +2609,7 @@ ZlibTransformSetOption( /* not used */ } if (Tcl_WriteRaw(cd->parent, cd->outBuffer, - cd->outStream.next_out - (Bytef*)cd->outBuffer) < 0) { + cd->outStream.next_out - (Bytef *) cd->outBuffer) < 0) { Tcl_AppendResult(interp, "problem flushing channel: ", Tcl_PosixError(interp), NULL); return TCL_ERROR; @@ -2521,9 +2622,24 @@ ZlibTransformSetOption( /* not used */ return Tcl_BadChannelOption(interp, optionName, chanOptions); } + /* + * Pass all unknown options down, to deeper transforms and/or the base + * channel. + */ + return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, optionName, value); } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformGetOption -- + * + * Reading side of [fconfigure] on our channel. + * + *---------------------------------------------------------------------- + */ static int ZlibTransformGetOption( @@ -2578,10 +2694,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; } @@ -2600,6 +2713,17 @@ ZlibTransformGetOption( } return Tcl_BadChannelOption(interp, optionName, chanOptions); } + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformWatch, ZlibTransformEventHandler -- + * + * If we have data pending, trigger a readable event after a short time + * (in order to allow a real event to catch up). + * + *---------------------------------------------------------------------- + */ static void ZlibTransformWatch( @@ -2615,63 +2739,28 @@ ZlibTransformWatch( watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); - if (!(mask & TCL_READABLE) - || (cd->inStream.avail_in == (uInt) cd->inAllocated)) { - ZlibTransformTimerKill(cd); - } else { - ZlibTransformTimerSetup(cd); - } -} -static int -ZlibTransformGetHandle( - ClientData instanceData, - int direction, - ClientData *handlePtr) -{ - ZlibChannelData *cd = instanceData; - - return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); -} - -static int -ZlibTransformBlockMode( - ClientData instanceData, - int mode) -{ - ZlibChannelData *cd = instanceData; - - if (mode == TCL_MODE_NONBLOCKING) { - cd->flags |= ASYNC; - } else { - cd->flags &= ~ASYNC; + if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) { + ZlibTransformEventTimerKill(cd); + } else if (cd->timer == NULL) { + cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ZlibTransformTimerRun, cd); } - return TCL_OK; } static int -ZlibTransformHandler( +ZlibTransformEventHandler( ClientData instanceData, int interestMask) { ZlibChannelData *cd = instanceData; - ZlibTransformTimerKill(cd); + ZlibTransformEventTimerKill(cd); return interestMask; } -static void -ZlibTransformTimerSetup( - ZlibChannelData *cd) -{ - if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY, - ZlibTransformTimerRun, cd); - } -} - -static void -ZlibTransformTimerKill( +static inline void +ZlibTransformEventTimerKill( ZlibChannelData *cd) { if (cd->timer != NULL) { @@ -2693,6 +2782,53 @@ ZlibTransformTimerRun( /* *---------------------------------------------------------------------- * + * ZlibTransformGetHandle -- + * + * Anything that needs the OS handle is told to get it from what we are + * stacked on top of. + * + *---------------------------------------------------------------------- + */ + +static int +ZlibTransformGetHandle( + ClientData instanceData, + int direction, + ClientData *handlePtr) +{ + ZlibChannelData *cd = instanceData; + + return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); +} + +/* + *---------------------------------------------------------------------- + * + * ZlibTransformBlockMode -- + * + * We need to keep track of the blocking mode; it changes our behavior. + * + *---------------------------------------------------------------------- + */ + +static int +ZlibTransformBlockMode( + ClientData instanceData, + int mode) +{ + ZlibChannelData *cd = instanceData; + + if (mode == TCL_MODE_NONBLOCKING) { + cd->flags |= ASYNC; + } else { + cd->flags &= ~ASYNC; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * ZlibStackChannelTransform -- * * Stacks either compression or decompression onto a channel. @@ -2804,6 +2940,8 @@ ZlibStackChannelTransform( } } + Tcl_DStringInit(&cd->decompressed); + chan = Tcl_StackChannel(interp, &zlibChannelType, cd, Tcl_GetChannelMode(channel), channel); if (chan == NULL) { @@ -2829,6 +2967,150 @@ ZlibStackChannelTransform( /* *---------------------------------------------------------------------- + * + * ResultCopy -- + * + * Copies the requested number of bytes from the buffer into the + * specified array and removes them from the buffer afterward. Copies + * less if there is not enough data in the buffer. + * + * Side effects: + * See above. + * + * Result: + * The number of actually copied bytes, possibly less than 'toRead'. + * + *---------------------------------------------------------------------- + */ + +static inline int +ResultCopy( + ZlibChannelData *cd, /* The location of the buffer to read from. */ + char *buf, /* The buffer to copy into */ + int toRead) /* Number of requested bytes */ +{ + int have = Tcl_DStringLength(&cd->decompressed); + + if (have == 0) { + /* + * Nothing to copy in the case of an empty buffer. + */ + + return 0; + } else if (have > toRead) { + /* + * The internal buffer contains more than requested. Copy the + * requested subset to the caller, shift the remaining bytes down, and + * truncate. + */ + + char *src = Tcl_DStringValue(&cd->decompressed); + + memcpy(buf, src, toRead); + memmove(src, src + toRead, have - toRead); + + Tcl_DStringSetLength(&cd->decompressed, have - toRead); + return toRead; + } else /* have <= toRead */ { + /* + * There is just or not enough in the buffer to fully satisfy the + * caller, so take everything as best effort. + */ + + memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); + TclDStringClear(&cd->decompressed); + return have; + } +} + +/* + *---------------------------------------------------------------------- + * + * ResultGenerate -- + * + * Extract uncompressed bytes from the compression engine and store them + * in our working buffer. + * + * Result: + * TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason). + * + * Side effects: + * See above. + * + *---------------------------------------------------------------------- + */ + +static int +ResultGenerate( + ZlibChannelData *cd, + int n, + int flush, + int *errorCodePtr) +{ +#define MAXBUF 1024 + unsigned char buf[MAXBUF]; + int e, written; + + cd->inStream.next_in = (Bytef *) cd->inBuffer; + cd->inStream.avail_in = n; + + while (1) { + cd->inStream.next_out = (Bytef *) buf; + cd->inStream.avail_out = MAXBUF; + + e = inflate(&cd->inStream, flush); + + /* + * avail_out is now the left over space in the output. Therefore + * "MAXBUF - avail_out" is the amount of bytes generated. + */ + + written = MAXBUF - cd->inStream.avail_out; + if (written) { + Tcl_DStringAppend(&cd->decompressed, (char *) buf, written); + } + + /* + * The cases where we're definitely done. + */ + + if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) + || (e == Z_STREAM_END) + || (e == Z_OK && cd->inStream.avail_out == 0)) { + return TCL_OK; + } + + /* + * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html + * + * Just indicates that the zlib couldn't consume input/produce output, + * and is fixed by supplying more input. + * + * Otherwise, we've got errors and need to report to higher-up. + */ + + if ((e != Z_OK) && (e != Z_BUF_ERROR)) { + Tcl_Obj *errObj = Tcl_NewListObj(0, NULL); + + Tcl_ListObjAppendElement(NULL, errObj, + Tcl_NewStringObj(cd->inStream.msg, -1)); + Tcl_SetChannelError(cd->parent, errObj); + *errorCodePtr = EINVAL; + return TCL_ERROR; + } + + /* + * Check if the inflate stopped early. + */ + + if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { + return TCL_OK; + } + } +} + +/* + *---------------------------------------------------------------------- * Finally, the TclZlibInit function. Used to install the zlib API. *---------------------------------------------------------------------- */ @@ -2850,7 +3132,7 @@ TclZlibInit( */ Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0); - return TCL_OK; + return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); } /* |