diff options
author | Kevin B Kenny <kennykb@acm.org> | 2014-06-29 02:20:31 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2014-06-29 02:20:31 (GMT) |
commit | 54aa5c1f2d5513d45d1361a3615125a4810cc1c0 (patch) | |
tree | 9e84f6c42d0fdc3d3a0958996705d2c2fbb5f722 /generic | |
parent | 2ac3c16d405d20153ce0ad43f308ff05bc372f7a (diff) | |
parent | c0edc29d67c0944180ce922c7f63d6dd3c3bdf6c (diff) | |
download | tcl-54aa5c1f2d5513d45d1361a3615125a4810cc1c0.zip tcl-54aa5c1f2d5513d45d1361a3615125a4810cc1c0.tar.gz tcl-54aa5c1f2d5513d45d1361a3615125a4810cc1c0.tar.bz2 |
merge trunk
Diffstat (limited to 'generic')
35 files changed, 1932 insertions, 1992 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index b7237bf..e557290 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -67,15 +67,12 @@ extern "C" { * We use this method because there is no autoconf equivalent. */ -#ifndef __WIN32__ -# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__)) +#ifdef _WIN32 +# ifndef __WIN32__ # define __WIN32__ -# ifndef WIN32 -# define WIN32 -# endif -# ifndef _WIN32 -# define _WIN32 -# endif +# endif +# ifndef WIN32 +# define WIN32 # endif #endif @@ -83,11 +80,11 @@ extern "C" { * STRICT: See MSDN Article Q83456 */ -#ifdef __WIN32__ +#ifdef _WIN32 # ifndef STRICT # define STRICT # endif -#endif /* __WIN32__ */ +#endif /* _WIN32 */ /* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double @@ -191,7 +188,7 @@ extern "C" { * MSVCRT. */ -#if (defined(__WIN32__) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec)))) +#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec)))) # define HAVE_DECLSPEC 1 # ifdef STATIC_BUILD # define DLLIMPORT @@ -315,14 +312,14 @@ extern "C" { * VOID. This block is skipped under Cygwin and Mingw. */ -#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID) +#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) #ifndef VOID #define VOID void typedef char CHAR; typedef short SHORT; typedef long LONG; #endif -#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */ +#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ /* * Macro to use instead of "void" for arguments that must have type "void *" @@ -390,7 +387,7 @@ typedef long LONG; */ #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) -# if defined(__WIN32__) +# if defined(_WIN32) # define TCL_WIDE_INT_TYPE __int64 # ifdef __BORLANDC__ # define TCL_LL_MODIFIER "L" @@ -400,7 +397,7 @@ typedef long LONG; # elif defined(__GNUC__) # define TCL_WIDE_INT_TYPE long long # define TCL_LL_MODIFIER "ll" -# else /* ! __WIN32__ && ! __GNUC__ */ +# else /* ! _WIN32 && ! __GNUC__ */ /* * Don't know what platform it is and configure hasn't discovered what is * going on for us. Try to guess... @@ -415,7 +412,7 @@ typedef long LONG; # define TCL_WIDE_INT_TYPE long long # endif # endif /* NO_LIMITS_H */ -# endif /* __WIN32__ */ +# endif /* _WIN32 */ #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */ #ifdef TCL_WIDE_INT_IS_LONG # undef TCL_WIDE_INT_TYPE @@ -447,7 +444,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #endif /* TCL_WIDE_INT_IS_LONG */ -#if defined(__WIN32__) +#if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; # elif defined(_WIN64) @@ -562,7 +559,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream; * will be called as the main fuction of the new thread created by that call. */ -#if defined __WIN32__ +#if defined _WIN32 typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData); #else typedef void (Tcl_ThreadCreateProc) (ClientData clientData); @@ -574,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData); * in generic/tclThreadTest.c for it's usage. */ -#if defined __WIN32__ +#if defined _WIN32 # define Tcl_ThreadCreateType unsigned __stdcall # define TCL_THREAD_CREATE_RETURN return 0 #else @@ -2436,9 +2433,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); /* * Include platform specific public function declarations that are accessible - * via the stubs table. + * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only + * has effect on building it as a shared library). See ticket [3010352]. */ +#if defined(BUILD_tcl) +# undef TCLAPI +# define TCLAPI MODULE_SCOPE +#endif + #include "tclPlatDecls.h" /* diff --git a/generic/tclClock.c b/generic/tclClock.c index 6d2976d..7e917f6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -19,7 +19,7 @@ * Windows has mktime. The configurators do not check. */ -#ifdef __WIN32__ +#ifdef _WIN32 #define HAVE_MKTIME 1 #endif @@ -548,18 +548,21 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK + || fieldPtr == NULL || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, &era) != TCL_OK - || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], - &fieldPtr) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK + || fieldPtr == NULL || TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK - || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], - &fieldPtr) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], &fieldPtr) != TCL_OK + || fieldPtr == NULL || TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK - || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], - &fieldPtr) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK + || fieldPtr == NULL || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { + if (fieldPtr == NULL) + Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1)); return TCL_ERROR; } fields.era = era; @@ -638,18 +641,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd( } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK + || fieldPtr == NULL || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, &era) != TCL_OK - || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], - &fieldPtr) != TCL_OK - || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Year)!=TCL_OK - || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], - &fieldPtr) != TCL_OK - || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Week)!=TCL_OK - || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], - &fieldPtr) != TCL_OK - || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfWeek) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK + || fieldPtr == NULL + || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK + || fieldPtr == NULL + || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK + || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK + || fieldPtr == NULL + || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) { + if (fieldPtr == NULL) + Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1)); return TCL_ERROR; } fields.era = era; @@ -1697,7 +1703,7 @@ ClockClicksObjCmd( case 1: break; case 2: - if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0, + if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1867,9 +1873,9 @@ ClockParseformatargsObjCmd( localeObj = litPtr[LIT_C]; timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0, + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &optionIndex) != TCL_OK) { - Tcl_SetErrorCode(interp, "CLOCK", "badSwitch", + Tcl_SetErrorCode(interp, "CLOCK", "badOption", Tcl_GetString(objv[i]), NULL); return TCL_ERROR; } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index f90819a..d90a747 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1590,7 +1590,7 @@ FileAttrIsOwnedCmd( * test for equivalence to the current user. */ -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(_WIN32) || defined(__CYGWIN__) value = 1; #else value = (geteuid() == buf.st_uid); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 41c1eb6..db216e5 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -29,7 +29,7 @@ typedef struct SortElement { union { /* The value that we sorting by. */ const char *strValuePtr; - long intValue; + Tcl_WideInt wideValue; double doubleValue; Tcl_Obj *objValuePtr; } collationKey; @@ -2893,7 +2893,8 @@ Tcl_LsearchObjCmd( { const char *bytes, *patternBytes; int i, match, index, result, listc, length, elemLen, bisect; - int dataType, isIncreasing, lower, upper, patInt, objInt, offset; + int dataType, isIncreasing, lower, upper, offset; + Tcl_WideInt patWide, objWide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; @@ -3212,7 +3213,7 @@ Tcl_LsearchObjCmd( patternBytes = TclGetStringFromObj(patObj, &length); break; case INTEGER: - result = TclGetIntFromObj(interp, patObj, &patInt); + result = TclGetWideIntFromObj(interp, patObj, &patWide); if (result != TCL_OK) { goto done; } @@ -3281,13 +3282,13 @@ Tcl_LsearchObjCmd( match = DictionaryCompare(patternBytes, bytes); break; case INTEGER: - result = TclGetIntFromObj(interp, itemPtr, &objInt); + result = TclGetWideIntFromObj(interp, itemPtr, &objWide); if (result != TCL_OK) { goto done; } - if (patInt == objInt) { + if (patWide == objWide) { match = 0; - } else if (patInt < objInt) { + } else if (patWide < objWide) { match = -1; } else { match = 1; @@ -3400,14 +3401,14 @@ Tcl_LsearchObjCmd( break; case INTEGER: - result = TclGetIntFromObj(interp, itemPtr, &objInt); + result = TclGetWideIntFromObj(interp, itemPtr, &objWide); if (result != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } goto done; } - match = (objInt == patInt); + match = (objWide == patWide); break; case REAL: @@ -3971,13 +3972,13 @@ Tcl_LsortObjCmd( if (sortMode == SORTMODE_ASCII) { elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr); } else if (sortMode == SORTMODE_INTEGER) { - long a; + Tcl_WideInt a; - if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { + if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done1; } - elementArray[i].collationKey.intValue = a; + elementArray[i].collationKey.wideValue = a; } else if (sortMode == SORTMODE_REAL) { double a; @@ -4226,10 +4227,10 @@ SortCompare( order = DictionaryCompare(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_INTEGER) { - long a, b; + Tcl_WideInt a, b; - a = elemPtr1->collationKey.intValue; - b = elemPtr2->collationKey.intValue; + a = elemPtr1->collationKey.wideValue; + b = elemPtr2->collationKey.wideValue; order = ((a >= b) - (a <= b)); } else if (infoPtr->sortMode == SORTMODE_REAL) { double a, b; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 00c9f2f..0f7f20a 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -161,7 +161,7 @@ Tcl_RegexpObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { goto optionError; } @@ -217,7 +217,7 @@ Tcl_RegexpObjCmd( endOfForLoop: if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, - "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); + "?-option ...? exp string ?matchVar? ?subMatchVar ...?"); goto optionError; } objc -= i; @@ -231,6 +231,8 @@ Tcl_RegexpObjCmd( if (doinline && ((objc - 2) != 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "regexp match variables not allowed when using -inline", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP", + "MIX_VAR_INLINE", NULL); goto optionError; } @@ -519,7 +521,7 @@ Tcl_RegsubObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", + if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option", TCL_EXACT, &index) != TCL_OK) { goto optionError; } @@ -566,7 +568,7 @@ Tcl_RegsubObjCmd( endOfForLoop: if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, - "?-switch ...? exp string subSpec ?varName?"); + "?-option ...? exp string subSpec ?varName?"); optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); @@ -3391,7 +3393,7 @@ TclSubstOptions( for (i = 0; i < numOpts; i++) { int optionIndex; - if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0, + if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } @@ -3591,7 +3593,7 @@ TclNRSwitchObjCmd( finishedOptions: if (objc - i < 2) { Tcl_WrongNumArgs(interp, 1, objv, - "?-switch ...? string ?pattern body ...? ?default body?"); + "?-option ...? string ?pattern body ...? ?default body?"); return TCL_ERROR; } if (indexVarObj != NULL && mode != OPT_REGEXP) { @@ -3638,7 +3640,7 @@ TclNRSwitchObjCmd( if (objc < 1) { Tcl_WrongNumArgs(interp, 1, savedObjv, - "?-switch ...? string {?pattern body ...? ?default body?}"); + "?-option ...? string {?pattern body ...? ?default body?}"); return TCL_ERROR; } objv = listv; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 830c998..91c0add 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -63,7 +63,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); /* 8 */ EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line); -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); @@ -73,7 +73,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask, EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ EXTERN void Tcl_DeleteFileHandler(int fd); #endif /* UNIX */ @@ -511,7 +511,7 @@ EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp); EXTERN const char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, @@ -1835,19 +1835,19 @@ typedef struct TclStubs { char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */ char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* UNIX */ -#if defined(__WIN32__) /* WIN */ +#if defined(_WIN32) /* WIN */ void (*reserved9)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ #endif /* UNIX */ -#if defined(__WIN32__) /* WIN */ +#if defined(_WIN32) /* WIN */ void (*reserved10)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -2009,10 +2009,10 @@ typedef struct TclStubs { Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#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 */ -#if defined(__WIN32__) /* WIN */ +#if defined(_WIN32) /* WIN */ void (*reserved167)(void); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -2513,7 +2513,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbCkfree) /* 7 */ #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif /* UNIX */ @@ -2521,7 +2521,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ #endif /* UNIX */ @@ -2841,7 +2841,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */ #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ #endif /* UNIX */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index e31d708..3c0ddd8 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -155,6 +155,13 @@ typedef struct Dict { } Dict; /* + * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this + * must be assignable as well as readable. + */ + +#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1)) + +/* * The structure below defines the dictionary object type by means of * functions that can be invoked by generic object code. */ @@ -312,6 +319,7 @@ DeleteChainEntry( return 0; } else { Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); + TclDecrRefCount(valuePtr); } @@ -361,7 +369,7 @@ DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1; + Dict *oldDict = DICT(srcPtr); Dict *newDict = ckalloc(sizeof(Dict)); ChainEntry *cPtr; @@ -396,7 +404,7 @@ DupDictInternalRep( * Store in the object. */ - copyPtr->internalRep.twoPtrValue.ptr1 = newDict; + DICT(copyPtr) = newDict; copyPtr->typePtr = &tclDictType; } @@ -422,7 +430,7 @@ static void FreeDictInternalRep( Tcl_Obj *dictPtr) { - Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1; + Dict *dict = DICT(dictPtr); dict->refcount--; if (dict->refcount <= 0) { @@ -487,7 +495,7 @@ UpdateStringOfDict( { #define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr = NULL; - Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1; + Dict *dict = DICT(dictPtr); ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; int i, length, bytesNeeded = 0; @@ -600,7 +608,7 @@ SetDictFromAny( Tcl_Obj *objPtr) { Tcl_HashEntry *hPtr; - int isNew, result; + int isNew; Dict *dict = ckalloc(sizeof(Dict)); InitChainTable(dict); @@ -651,10 +659,9 @@ SetDictFromAny( const char *elemStart; int elemSize, literal; - result = TclFindElement(interp, nextElem, (limit - nextElem), - &elemStart, &nextElem, &elemSize, &literal); - if (result != TCL_OK) { - goto errorExit; + if (TclFindDictElement(interp, nextElem, (limit - nextElem), + &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { + goto errorInFindDictElement; } if (elemStart == limit) { break; @@ -673,11 +680,10 @@ SetDictFromAny( keyPtr->bytes); } - result = TclFindElement(interp, nextElem, (limit - nextElem), - &elemStart, &nextElem, &elemSize, &literal); - if (result != TCL_OK) { + if (TclFindDictElement(interp, nextElem, (limit - nextElem), + &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { TclDecrRefCount(keyPtr); - goto errorExit; + goto errorInFindDictElement; } if (literal) { @@ -713,7 +719,7 @@ SetDictFromAny( dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - objPtr->internalRep.twoPtrValue.ptr1 = dict; + DICT(objPtr) = dict; objPtr->typePtr = &tclDictType; return TCL_OK; @@ -723,15 +729,10 @@ SetDictFromAny( "missing value to go with key", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); } - result = TCL_ERROR; - - errorExit: - if (interp != NULL) { - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); - } + errorInFindDictElement: DeleteChainTable(dict); ckfree(dict); - return result; + return TCL_ERROR; } /* @@ -777,12 +778,11 @@ TclTraceDictPath( Dict *dict, *newDict; int i; - if (dictPtr->typePtr != &tclDictType) { - if (SetDictFromAny(interp, dictPtr) != TCL_OK) { - return NULL; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); if (flags & DICT_PATH_UPDATE) { dict->chain = NULL; } @@ -818,14 +818,13 @@ TclTraceDictPath( Tcl_SetHashValue(hPtr, tmpObj); } else { tmpObj = Tcl_GetHashValue(hPtr); - if (tmpObj->typePtr != &tclDictType) { - if (SetDictFromAny(interp, tmpObj) != TCL_OK) { - return NULL; - } + if (tmpObj->typePtr != &tclDictType + && SetDictFromAny(interp, tmpObj) != TCL_OK) { + return NULL; } } - newDict = tmpObj->internalRep.twoPtrValue.ptr1; + newDict = DICT(tmpObj); if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { TclDecrRefCount(tmpObj); @@ -833,7 +832,7 @@ TclTraceDictPath( Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); dict->epoch++; - newDict = tmpObj->internalRep.twoPtrValue.ptr1; + newDict = DICT(tmpObj); } newDict->chain = dictPtr; @@ -868,7 +867,7 @@ static void InvalidateDictChain( Tcl_Obj *dictObj) { - Dict *dict = dictObj->internalRep.twoPtrValue.ptr1; + Dict *dict = DICT(dictObj); do { TclInvalidateStringRep(dictObj); @@ -878,7 +877,7 @@ InvalidateDictChain( break; } dict->chain = NULL; - dict = dictObj->internalRep.twoPtrValue.ptr1; + dict = DICT(dictObj); } while (dict != NULL); } @@ -916,18 +915,15 @@ Tcl_DictObjPut( Tcl_Panic("%s called with shared object", "Tcl_DictObjPut"); } - if (dictPtr->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, dictPtr); - - if (result != TCL_OK) { - return result; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; } if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); hPtr = CreateChainEntry(dict, keyPtr, &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { @@ -970,15 +966,13 @@ Tcl_DictObjGet( Dict *dict; Tcl_HashEntry *hPtr; - if (dictPtr->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, dictPtr); - if (result != TCL_OK) { - *valuePtrPtr = NULL; - return result; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + *valuePtrPtr = NULL; + return TCL_ERROR; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); hPtr = Tcl_FindHashEntry(&dict->table, keyPtr); if (hPtr == NULL) { *valuePtrPtr = NULL; @@ -1019,18 +1013,16 @@ Tcl_DictObjRemove( Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove"); } - if (dictPtr->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, dictPtr); - if (result != TCL_OK) { - return result; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; } - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); - } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); if (DeleteChainEntry(dict, keyPtr)) { + if (dictPtr->bytes != NULL) { + TclInvalidateStringRep(dictPtr); + } dict->epoch++; } return TCL_OK; @@ -1062,14 +1054,12 @@ Tcl_DictObjSize( { Dict *dict; - if (dictPtr->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, dictPtr); - if (result != TCL_OK) { - return result; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); *sizePtr = dict->table.numEntries; return TCL_OK; } @@ -1116,15 +1106,12 @@ Tcl_DictObjFirst( Dict *dict; ChainEntry *cPtr; - if (dictPtr->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, dictPtr); - - if (result != TCL_OK) { - return result; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); cPtr = dict->entryChainHead; if (cPtr == NULL) { searchPtr->epoch = -1; @@ -1299,11 +1286,12 @@ Tcl_DictObjPutKeyList( return TCL_ERROR; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr); + TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); @@ -1355,7 +1343,7 @@ Tcl_DictObjRemoveKeyList( return TCL_ERROR; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); DeleteChainEntry(dict, keyv[keyc-1]); InvalidateDictChain(dictPtr); return TCL_OK; @@ -1401,7 +1389,7 @@ Tcl_NewDictObj(void) dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - dictPtr->internalRep.twoPtrValue.ptr1 = dict; + DICT(dictPtr) = dict; dictPtr->typePtr = &tclDictType; return dictPtr; #endif @@ -1450,7 +1438,7 @@ Tcl_DbNewDictObj( dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - dictPtr->internalRep.twoPtrValue.ptr1 = dict; + DICT(dictPtr) = dict; dictPtr->typePtr = &tclDictType; return dictPtr; #else /* !TCL_MEM_DEBUG */ @@ -1504,7 +1492,7 @@ DictCreateCmd( /* * The next command is assumed to never fail... */ - Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]); + Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]); } Tcl_SetObjResult(interp, dictObj); return TCL_OK; @@ -1629,8 +1617,7 @@ DictReplaceCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; - int i, result; - int allocatedDict = 0; + int i; if ((objc < 2) || (objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?"); @@ -1638,18 +1625,18 @@ DictReplaceCmd( } dictPtr = objv[1]; + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; + } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); - allocatedDict = 1; + } + if (dictPtr->bytes != NULL) { + TclInvalidateStringRep(dictPtr); } for (i=2 ; i<objc ; i+=2) { - result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]); - if (result != TCL_OK) { - if (allocatedDict) { - TclDecrRefCount(dictPtr); - } - return TCL_ERROR; - } + Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -1681,8 +1668,7 @@ DictRemoveCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; - int i, result; - int allocatedDict = 0; + int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?"); @@ -1690,18 +1676,18 @@ DictRemoveCmd( } dictPtr = objv[1]; + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; + } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); - allocatedDict = 1; + } + if (dictPtr->bytes != NULL) { + TclInvalidateStringRep(dictPtr); } for (i=2 ; i<objc ; i++) { - result = Tcl_DictObjRemove(interp, dictPtr, objv[i]); - if (result != TCL_OK) { - if (allocatedDict) { - TclDecrRefCount(dictPtr); - } - return TCL_ERROR; - } + Tcl_DictObjRemove(NULL, dictPtr, objv[i]); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -1750,10 +1736,9 @@ DictMergeCmd( */ targetObj = objv[1]; - if (targetObj->typePtr != &tclDictType) { - if (SetDictFromAny(interp, targetObj) != TCL_OK) { - return TCL_ERROR; - } + if (targetObj->typePtr != &tclDictType + && SetDictFromAny(interp, targetObj) != TCL_OK) { + return TCL_ERROR; } if (objc == 2) { @@ -1835,12 +1820,9 @@ DictKeysCmd( * need. [Bug 1705778, leak K04] */ - if (objv[1]->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, objv[1]); - - if (result != TCL_OK) { - return result; - } + if (objv[1]->typePtr != &tclDictType + && SetDictFromAny(interp, objv[1]) != TCL_OK) { + return TCL_ERROR; } if (objc == 3) { @@ -2056,13 +2038,11 @@ DictInfoCmd( } dictPtr = objv[1]; - if (dictPtr->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, dictPtr); - if (result != TCL_OK) { - return result; - } + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return TCL_ERROR; } - dict = dictPtr->internalRep.twoPtrValue.ptr1; + dict = DICT(dictPtr); statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); @@ -2099,7 +2079,7 @@ DictIncrCmd( Tcl_Obj *dictPtr, *valuePtr = NULL; if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?"); return TCL_ERROR; } @@ -2152,10 +2132,10 @@ DictIncrCmd( */ mp_clear(&increment); - Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]); + Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]); } } else { - Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1)); + Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1)); } } else { /* @@ -2164,7 +2144,7 @@ DictIncrCmd( if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); - Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); + Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); } if (objc == 4) { code = TclIncrObj(interp, valuePtr, objv[3]); @@ -2173,7 +2153,7 @@ DictIncrCmd( Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); - Tcl_DecrRefCount(incrPtr); + TclDecrRefCount(incrPtr); } } if (code == TCL_OK) { @@ -2186,7 +2166,7 @@ DictIncrCmd( Tcl_SetObjResult(interp, valuePtr); } } else if (dictPtr->refCount == 0) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return code; } @@ -2220,7 +2200,7 @@ DictLappendCmd( int i, allocatedDict = 0, allocatedValue = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); return TCL_ERROR; } @@ -2264,7 +2244,7 @@ DictLappendCmd( } if (allocatedValue) { - Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); + Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); } else if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } @@ -2307,7 +2287,7 @@ DictAppendCmd( int i, allocatedDict = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); return TCL_ERROR; } @@ -2329,17 +2309,15 @@ DictAppendCmd( if (valuePtr == NULL) { TclNewObj(valuePtr); - } else { - if (Tcl_IsShared(valuePtr)) { - valuePtr = Tcl_DuplicateObj(valuePtr); - } + } else if (Tcl_IsShared(valuePtr)) { + valuePtr = Tcl_DuplicateObj(valuePtr); } for (i=3 ; i<objc ; i++) { Tcl_AppendObjToObj(valuePtr, objv[i]); } - Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); + Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); @@ -2383,7 +2361,7 @@ DictForNRCmd( if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, - "{keyVar valueVar} dictionary script"); + "{keyVarName valueVarName} dictionary script"); return TCL_ERROR; } @@ -2397,6 +2375,7 @@ DictForNRCmd( if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); + Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL); return TCL_ERROR; } searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch)); @@ -2430,12 +2409,14 @@ DictForNRCmd( */ Tcl_IncrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, + TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(valueObj); goto error; } TclDecrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, + TCL_LEAVE_ERR_MSG) == NULL) { goto error; } @@ -2574,7 +2555,7 @@ DictMapNRCmd( if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, - "{keyVar valueVar} dictionary script"); + "{keyVarName valueVarName} dictionary script"); return TCL_ERROR; } @@ -2588,6 +2569,7 @@ DictMapNRCmd( if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); + Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL); return TCL_ERROR; } storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage)); @@ -2782,7 +2764,7 @@ DictSetCmd( int result, allocatedDict = 0; if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value"); return TCL_ERROR; } @@ -2842,7 +2824,7 @@ DictUnsetCmd( int result, allocatedDict = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?"); return TCL_ERROR; } @@ -2949,12 +2931,12 @@ DictFilterCmd( Tcl_DictObjDone(&search); Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj); if (valueObj != NULL) { - Tcl_DictObjPut(interp, resultObj, objv[3], valueObj); + Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj); } } else { while (!done) { if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { - Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } @@ -2972,7 +2954,7 @@ DictFilterCmd( for (i=3 ; i<objc ; i++) { pattern = TclGetString(objv[i]); if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { - Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); break; /* stop inner loop */ } } @@ -2998,7 +2980,7 @@ DictFilterCmd( for (i=3 ; i<objc ; i++) { pattern = TclGetString(objv[i]); if (Tcl_StringMatch(TclGetString(valueObj), pattern)) { - Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); break; /* stop inner loop */ } } @@ -3010,7 +2992,7 @@ DictFilterCmd( case FILTER_SCRIPT: if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, - "dictionary script {keyVar valueVar} filterScript"); + "dictionary script {keyVarName valueVarName} filterScript"); return TCL_ERROR; } @@ -3026,6 +3008,7 @@ DictFilterCmd( if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); + Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL); return TCL_ERROR; } keyVarObj = varv[0]; @@ -3064,19 +3047,15 @@ DictFilterCmd( Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set key variable: \"%s\"", - TclGetString(keyVarObj))); + Tcl_AddErrorInfo(interp, + "\n (\"dict filter\" filter script key variable)"); result = TCL_ERROR; goto abnormalResult; } if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set value variable: \"%s\"", - TclGetString(valueVarObj))); + Tcl_AddErrorInfo(interp, + "\n (\"dict filter\" filter script value variable)"); result = TCL_ERROR; goto abnormalResult; } @@ -3099,7 +3078,7 @@ DictFilterCmd( } TclDecrRefCount(boolObj); if (satisfied) { - Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); } break; case TCL_BREAK: @@ -3190,7 +3169,7 @@ DictUpdateCmd( if (objc < 5 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, - "varName key varName ?key varName ...? script"); + "dictVarName key varName ?key varName ...? script"); return TCL_ERROR; } @@ -3287,18 +3266,17 @@ FinalizeDictUpdate( for (i=0 ; i<objc ; i+=2) { objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0); if (objPtr == NULL) { - Tcl_DictObjRemove(interp, dictPtr, objv[i]); + Tcl_DictObjRemove(NULL, dictPtr, objv[i]); } else if (objPtr == dictPtr) { /* * Someone is messing us around, trying to build a recursive * structure. [Bug 1786481] */ - Tcl_DictObjPut(interp, dictPtr, objv[i], - Tcl_DuplicateObj(objPtr)); + Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr)); } else { /* Shouldn't fail */ - Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr); + Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr); } } TclDecrRefCount(argsObj); @@ -3347,7 +3325,7 @@ DictWithCmd( Tcl_Obj *dictPtr, *keysPtr, *pathPtr; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script"); return TCL_ERROR; } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 9bb7a0c..022dafa 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2751,13 +2751,6 @@ TclCompileEnsemble( const char *word; Tcl_IncrRefCount(replaced); - - /* - * This is where we return to if we are parsing multiple nested compiled - * ensembles. [info object] is such a beast. - */ - - checkNextWord: if (parsePtr->numWords < depth + 1) { goto failed; } @@ -2769,6 +2762,12 @@ TclCompileEnsemble( goto failed; } + /* + * This is where we return to if we are parsing multiple nested compiled + * ensembles. [info object] is such a beast. + */ + + checkNextWord: word = tokenPtr[1].start; numBytes = tokenPtr[1].size; @@ -2979,6 +2978,17 @@ TclCompileEnsemble( if (cmdPtr->compileProc == TclCompileEnsemble) { tokenPtr = TokenAfter(tokenPtr); + if (parsePtr->numWords < depth + 1 + || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + /* + * Too hard because the user has done something unpleasant like + * omitting the sub-ensemble's command name or used a non-constant + * name for a sub-ensemble's command name; we respond by bailing + * out completely (this is a rare case). [Bug 6d2f249a01] + */ + + goto cleanup; + } ensemble = (Tcl_Command) cmdPtr; goto checkNextWord; } diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 8f51c1b..cd1a954 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -444,7 +444,7 @@ TclUnsetEnv( * that no = should be included, and Windows requires it. */ -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(_WIN32) || defined(__CYGWIN__) string = ckalloc(length + 2); memcpy(string, name, (size_t) length); string[length] = '='; @@ -453,7 +453,7 @@ TclUnsetEnv( string = ckalloc(length + 1); memcpy(string, name, (size_t) length); string[length] = '\0'; -#endif /* WIN32 */ +#endif /* _WIN32 */ Tcl_UtfToExternalDString(NULL, string, -1, &envString); string = ckrealloc(string, Tcl_DStringLength(&envString) + 1); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 89305e6..d8c5935 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -556,30 +556,6 @@ VarHashCreateVar( : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) /* - * Macro used in this file to save a function call for common uses of - * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: - * - * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - * Tcl_WideInt *wideIntPtr); - */ - -#ifdef TCL_WIDE_INT_IS_LONG -#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - (((objPtr)->typePtr == &tclIntType) \ - ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.longValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#else /* !TCL_WIDE_INT_IS_LONG */ -#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - (((objPtr)->typePtr == &tclWideIntType) \ - ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ - ((objPtr)->typePtr == &tclIntType) \ - ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.longValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#endif /* TCL_WIDE_INT_IS_LONG */ - -/* * Macro used to make the check for type overflow more mnemonic. This works by * comparing sign bits; the rest of the word is irrelevant. The ANSI C * "prototype" (where inttype_t is any integer type) is: @@ -5392,6 +5368,7 @@ TEBCresume( } else { length = Tcl_UtfToUpper(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, length); + TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -5408,6 +5385,7 @@ TEBCresume( } else { length = Tcl_UtfToLower(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, length); + TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -5424,6 +5402,7 @@ TEBCresume( } else { length = Tcl_UtfToTitle(TclGetString(valuePtr)); Tcl_SetObjLength(valuePtr, length); + TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -5699,11 +5678,21 @@ TEBCresume( length - toIdx); } } else { - objResultPtr = value3Ptr; + /* + * Be careful with splicing the stack in this case; we have a + * refCount:1 object in value3Ptr and we want to append to it and + * make it be the refCount:1 object at the top of the stack + * afterwards. [Bug 82e7f67325] + */ + if (toIdx < length) { - Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1, length - toIdx); } + TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); + TclDecrRefCount(valuePtr); + OBJ_AT_TOS = value3Ptr; /* Tricky! */ + NEXT_INST_F(1, 0, 0); } TclDecrRefCount(value3Ptr); TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); @@ -5986,6 +5975,31 @@ TEBCresume( case INST_NUM_TYPE: if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; + } else if (type1 == TCL_NUMBER_LONG) { + /* value is between LONG_MIN and LONG_MAX */ + /* [string is integer] is -UINT_MAX to UINT_MAX range */ + int i; + + if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) { + type1 = TCL_NUMBER_WIDE; + } +#ifndef TCL_WIDE_INT_IS_LONG + } else if (type1 == TCL_NUMBER_WIDE) { + /* value is between WIDE_MIN and WIDE_MAX */ + /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ + int i; + if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) { + type1 = TCL_NUMBER_LONG; + } +#endif + } else if (type1 == TCL_NUMBER_BIG) { + /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ + /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */ + Tcl_WideInt w; + + if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { + type1 = TCL_NUMBER_WIDE; + } } TclNewIntObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 13377d3..8bf0a5a 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -517,7 +517,7 @@ CopyRenameOneFile( * 16 bits and we get collisions. See bug #2015723. */ -#if !defined(WIN32) && !defined(__CYGWIN__) +#if !defined(_WIN32) && !defined(__CYGWIN__) if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) { if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) && (sourceStatBuf.st_dev == targetStatBuf.st_dev)) { @@ -1196,7 +1196,7 @@ TclFileLinkCmd( static const char *const linkTypes[] = { "-symbolic", "-hard", NULL }; - if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0, + if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "option", 0, &linkAction) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclIO.c b/generic/tclIO.c index ff975c3..c8c9aec 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -6,6 +6,7 @@ * * Copyright (c) 1998-2000 Ajuba Solutions * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Contributions from Don Porter, NIST, 2014. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -162,7 +163,11 @@ typedef struct CloseCallback { */ static ChannelBuffer * AllocChannelBuffer(int length); +static void PreserveChannelBuffer(ChannelBuffer *bufPtr); +static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); +static int IsShared(ChannelBuffer *bufPtr); static void ChannelTimerProc(ClientData clientData); +static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, int direction); static int CheckForDeadChannel(Tcl_Interp *interp, @@ -176,9 +181,6 @@ static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, int errorCode, int flags); static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); -static int CopyAndTranslateBuffer(ChannelState *statePtr, - char *result, int space); -static int CopyBuffer(Channel *chanPtr, char *result, int space); static int CopyData(CopyState *csPtr, int mask); static void CopyEventProc(ClientData clientData, int mask); static void CreateScriptRecord(Tcl_Interp *interp, @@ -191,7 +193,8 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan); static void DiscardInputQueued(ChannelState *statePtr, int discardSavedBuffers); static void DiscardOutputQueued(ChannelState *chanPtr); -static int DoRead(Channel *chanPtr, char *srcPtr, int slen, int allowShortReads); +static int DoRead(Channel *chanPtr, char *dst, int bytesToRead, + int allowShortReads); static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead, int appendFlag); static int FilterInputBytes(Channel *chanPtr, @@ -208,16 +211,16 @@ static int HaveVersion(const Tcl_ChannelType *typePtr, static void PeekAhead(Channel *chanPtr, char **dstEndPtr, GetsState *gsPtr); static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr, - int charsLeft, int *offsetPtr); + int charsLeft); static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr, - int charsLeft, int *offsetPtr, int *factorPtr); + int charsLeft, int *factorPtr); static void RecycleBuffer(ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard); static int StackSetBlockMode(Channel *chanPtr, int mode); static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr, int mode); static void StopCopy(CopyState *csPtr); -static int TranslateInputEOL(ChannelState *statePtr, char *dst, +static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); static int Write(Channel *chanPtr, const char *src, @@ -284,7 +287,7 @@ static int WillRead(Channel *chanPtr); #define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved) -#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength) +#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength) #define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength) @@ -379,19 +382,79 @@ ChanCloseHalf( return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags); } -static inline int +/* + *--------------------------------------------------------------------------- + * + * ChanRead -- + * + * Read up to dstSize bytes using the inputProc of chanPtr, store + * them at dst, and return the number of bytes stored. + * + * Results: + * The return value of the driver inputProc, + * - number of bytes stored at dst, ot + * - -1 on error, with a Posix error code available to the + * caller by calling Tcl_GetErrno(). + * + * Side effects: + * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are + * set as appropriate. + * On EOF, the inputEncodingFlags are set to perform ending operations + * on decoding. + * TODO - Is this really the right place for that? + * + *--------------------------------------------------------------------------- + */ +static int ChanRead( Channel *chanPtr, char *dst, - int dstSize, - int *errnoPtr) + int dstSize) { + int bytesRead, result; + + /* + * If the caller asked for zero bytes, we'd force the inputProc + * to return zero bytes, and then misinterpret that as EOF. + */ + assert(dstSize > 0); + + /* + * Each read op must set the blocked and eof states anew, not let + * the effect of prior reads leak through. + */ + ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); if (WillRead(chanPtr) < 0) { return -1; } - return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, - errnoPtr); + bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, + dst, dstSize, &result); + + /* Stop any flag leakage through stacked channel levels */ + ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); + if (bytesRead > 0) { + /* + * If we get a short read, signal up that we may be BLOCKED. + * We should avoid calling the driver because on some + * platforms we will block in the low level reading code even + * though the channel is set into nonblocking mode. + */ + + if (bytesRead < dstSize) { + SetFlag(chanPtr->state, CHANNEL_BLOCKED); + } + } else if (bytesRead == 0) { + SetFlag(chanPtr->state, CHANNEL_EOF); + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; + } else if (bytesRead < 0) { + if ((result == EWOULDBLOCK) || (result == EAGAIN)) { + SetFlag(chanPtr->state, CHANNEL_BLOCKED); + result = EAGAIN; + } + Tcl_SetErrno(result); + } + return bytesRead; } static inline Tcl_WideInt @@ -1174,15 +1237,6 @@ Tcl_UnregisterChannel( */ if (statePtr->refCount <= 0) { - /* - * Ensure that if there is another buffer, it gets flushed whether or - * not we are doing a background flush. - */ - - if ((statePtr->curOutPtr != NULL) && - IsBufferReady(statePtr->curOutPtr)) { - SetFlag(statePtr, BUFFER_READY); - } Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* @@ -1743,6 +1797,10 @@ Tcl_StackChannel( statePtr->csPtrR = NULL; statePtr->csPtrW = NULL; + /* + * TODO: Examine what can go wrong if Tcl_Flush() call disturbs + * the stacking state of this channel during its operations. + */ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; @@ -1774,17 +1832,17 @@ Tcl_StackChannel( */ if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) { + /* - * Remark: It is possible that the channel buffers contain data from - * some earlier push-backs. + * When statePtr->inQueueHead is not NULL, we know + * prevChanPtr->inQueueHead must be NULL. */ - statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead; - prevChanPtr->inQueueHead = statePtr->inQueueHead; + assert(prevChanPtr->inQueueHead == NULL); + assert(prevChanPtr->inQueueTail == NULL); - if (prevChanPtr->inQueueTail == NULL) { - prevChanPtr->inQueueTail = statePtr->inQueueTail; - } + prevChanPtr->inQueueHead = statePtr->inQueueHead; + prevChanPtr->inQueueTail = statePtr->inQueueTail; statePtr->inQueueHead = NULL; statePtr->inQueueTail = NULL; @@ -1872,6 +1930,13 @@ Tcl_UnstackChannel( * into the old structure. */ + /* + * TODO: Figure out how to handle the situation where the chan + * operations called below by this unstacking operation cause + * another unstacking recursively. In that case the downChanPtr + * value we're holding on to will not be the right thing. + */ + Channel *downChanPtr = chanPtr->downChanPtr; /* @@ -1976,7 +2041,7 @@ Tcl_UnstackChannel( */ Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC); - UpdateInterest(downChanPtr); + UpdateInterest(statePtr->topChanPtr); if (result != 0) { Tcl_SetErrno(result); @@ -2288,8 +2353,36 @@ AllocChannelBuffer( bufPtr->nextRemoved = BUFFER_PADDING; bufPtr->bufLength = length + BUFFER_PADDING; bufPtr->nextPtr = NULL; + bufPtr->refCount = 1; return bufPtr; } + +static void +PreserveChannelBuffer( + ChannelBuffer *bufPtr) +{ + if (bufPtr->refCount == 0) { + Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); + } + bufPtr->refCount++; +} + +static void +ReleaseChannelBuffer( + ChannelBuffer *bufPtr) +{ + if (--bufPtr->refCount) { + return; + } + ckfree(bufPtr); +} + +static int +IsShared( + ChannelBuffer *bufPtr) +{ + return bufPtr->refCount > 1; +} /* *---------------------------------------------------------------------- @@ -2320,20 +2413,23 @@ RecycleBuffer( /* * Do we have to free the buffer to the OS? */ + if (IsShared(bufPtr)) { + mustDiscard = 1; + } if (mustDiscard) { - ckfree(bufPtr); + ReleaseChannelBuffer(bufPtr); return; } /* - * Only save buffers which are at least as big as the requested buffersize - * for the channel. This is to honor dynamic changes of the buffersize + * Only save buffers which have the requested buffersize for the + * channel. This is to honor dynamic changes of the buffersize * made by the user. */ - if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) { - ckfree(bufPtr); + if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) { + ReleaseChannelBuffer(bufPtr); return; } @@ -2368,7 +2464,7 @@ RecycleBuffer( * If we reached this code we return the buffer to the OS. */ - ckfree(bufPtr); + ReleaseChannelBuffer(bufPtr); return; keepBuffer: @@ -2406,6 +2502,11 @@ DiscardOutputQueued( } statePtr->outQueueHead = NULL; statePtr->outQueueTail = NULL; + bufPtr = statePtr->curOutPtr; + if (bufPtr && BytesLeft(bufPtr)) { + statePtr->curOutPtr = NULL; + RecycleBuffer(statePtr, bufPtr, 0); + } } /* @@ -2473,8 +2574,6 @@ FlushChannel( ChannelState *statePtr = chanPtr->state; /* State of the channel stack. */ ChannelBuffer *bufPtr; /* Iterates over buffered output queue. */ - int toWrite; /* Amount of output data in current buffer - * available to be written. */ int written; /* Amount of output data actually written in * current round. */ int errorCode = 0; /* Stores POSIX error codes from channel @@ -2494,63 +2593,58 @@ FlushChannel( } /* - * Loop over the queued buffers and attempt to flush as much as possible - * of the queued output to the channel. + * Should we shift the current output buffer over to the output queue? + * First check that there are bytes in it. If so then... + * If the output queue is empty, then yes, trusting the caller called + * us only when written bytes ought to be flushed. + * If the current output buffer is full, then yes, so we can meet + * the post-condition that on a successful return to caller we've + * left space in the current output buffer for more writing (the flush + * call was to make new room). + * Otherwise, no. Keep the current output buffer where it is so more + * can be written to it, possibly filling it, to promote more efficient + * buffer usage. */ - Tcl_Preserve(chanPtr); - while (1) { - /* - * If the queue is empty and there is a ready current buffer, OR if - * the current buffer is full, then move the current buffer to the - * queue. - */ - - if (((statePtr->curOutPtr != NULL) && - IsBufferFull(statePtr->curOutPtr)) - || (GotFlag(statePtr, BUFFER_READY) && - (statePtr->outQueueHead == NULL))) { - ResetFlag(statePtr, BUFFER_READY); - statePtr->curOutPtr->nextPtr = NULL; - if (statePtr->outQueueHead == NULL) { - statePtr->outQueueHead = statePtr->curOutPtr; - } else { - statePtr->outQueueTail->nextPtr = statePtr->curOutPtr; - } - statePtr->outQueueTail = statePtr->curOutPtr; - statePtr->curOutPtr = NULL; + bufPtr = statePtr->curOutPtr; + if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */ + (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) { + if (statePtr->outQueueHead == NULL) { + statePtr->outQueueHead = bufPtr; + } else { + statePtr->outQueueTail->nextPtr = bufPtr; } - bufPtr = statePtr->outQueueHead; + statePtr->outQueueTail = bufPtr; + statePtr->curOutPtr = NULL; + } - /* - * If we are not being called from an async flush and an async flush - * is active, we just return without producing any output. - */ + assert(!IsBufferFull(statePtr->curOutPtr)); - if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { - errorCode = 0; - goto done; - } + /* + * If we are not being called from an async flush and an async flush + * is active, we just return without producing any output. + */ - /* - * If the output queue is still empty, break out of the while loop. - */ + if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + return 0; + } - if (bufPtr == NULL) { - break; /* Out of the "while (1)". */ - } + /* + * Loop over the queued buffers and attempt to flush as much as possible + * of the queued output to the channel. + */ + + Tcl_Preserve(chanPtr); + while (statePtr->outQueueHead) { + bufPtr = statePtr->outQueueHead; /* * Produce the output on the channel. */ - toWrite = BytesLeft(bufPtr); - if (toWrite == 0) { - written = 0; - } else { - written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite, - &errorCode); - } + PreserveChannelBuffer(bufPtr); + written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr), + &errorCode); /* * If the write failed completely attempt to start the asynchronous @@ -2565,6 +2659,7 @@ FlushChannel( if (errorCode == EINTR) { errorCode = 0; + ReleaseChannelBuffer(bufPtr); continue; } @@ -2586,6 +2681,7 @@ FlushChannel( UpdateInterest(chanPtr); } errorCode = 0; + ReleaseChannelBuffer(bufPtr); break; } @@ -2647,14 +2743,15 @@ FlushChannel( */ DiscardOutputQueued(statePtr); - continue; + ReleaseChannelBuffer(bufPtr); + break; } else { + /* TODO: Consider detecting and reacting to short writes + * on blocking channels. Ought not happen. See iocmd-24.2. */ wroteSome = 1; } - if (!IsBufferEmpty(bufPtr)) { - bufPtr->nextRemoved += written; - } + bufPtr->nextRemoved += written; /* * If this buffer is now empty, recycle it. @@ -2667,7 +2764,8 @@ FlushChannel( } RecycleBuffer(statePtr, bufPtr, 0); } - } /* Closes "while (1)". */ + ReleaseChannelBuffer(bufPtr); + } /* Closes "while". */ /* * If we wrote some data while flushing in the background, we are done. @@ -2682,6 +2780,19 @@ FlushChannel( } else if (statePtr->outQueueHead == NULL) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); ChanWatch(chanPtr, statePtr->interestMask); + } else { + + /* + * When we are calledFromAsyncFlush, that means a writable + * state on the channel triggered the call, so we should be + * able to write something. Either we did write something + * and wroteSome should be set, or there was nothing left to + * write in this call, and we've completed the BG flush. + * These are the two cases above. If we get here, that means + * there is some kind failure in the writable event machinery. + */ + + assert(!calledFromAsyncFlush); } } @@ -2768,7 +2879,7 @@ CloseChannel( */ if (statePtr->curOutPtr != NULL) { - ckfree(statePtr->curOutPtr); + ReleaseChannelBuffer(statePtr->curOutPtr); statePtr->curOutPtr = NULL; } @@ -3180,10 +3291,18 @@ Tcl_Close( stickyError = 0; - if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) - && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { - statePtr->outputEncodingFlags |= TCL_ENCODING_END; - if (WriteChars(chanPtr, "", 0) < 0) { + if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) + && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { + + int code = CheckChannelErrors(statePtr, TCL_WRITABLE); + + if (code == 0) { + statePtr->outputEncodingFlags |= TCL_ENCODING_END; + code = WriteChars(chanPtr, "", 0); + statePtr->outputEncodingFlags &= ~TCL_ENCODING_END; + statePtr->outputEncodingFlags |= TCL_ENCODING_START; + } + if (code < 0) { stickyError = Tcl_GetErrno(); } @@ -3218,14 +3337,6 @@ Tcl_Close( ResetFlag(statePtr, CHANNEL_INCLOSE); /* - * Ensure that the last output buffer will be flushed. - */ - - if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - SetFlag(statePtr, BUFFER_READY); - } - - /* * If this channel supports it, close the read side, since we don't need * it anymore and this will help avoid deadlocks on some channel types. */ @@ -3270,7 +3381,17 @@ Tcl_Close( Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } - flushcode = -1; + return TCL_ERROR; + } + /* + * Bug 97069ea11a: set error message if a flush code is set and no error + * message set up to now. + */ + if (flushcode != 0 && interp != NULL + && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) { + Tcl_SetErrno(flushcode); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } if ((flushcode != 0) || (result != 0)) { return TCL_ERROR; @@ -3383,10 +3504,6 @@ Tcl_CloseEx( return CloseChannelPart(interp, chanPtr, 0, flags); } else if (flags & TCL_CLOSE_WRITE) { - if ((statePtr->curOutPtr != NULL) && - IsBufferReady(statePtr->curOutPtr)) { - SetFlag(statePtr, BUFFER_READY); - } Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* @@ -3448,14 +3565,6 @@ CloseWrite( int result = 0; /* - * Ensure that the last output buffer will be flushed. - */ - - if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - SetFlag(statePtr, BUFFER_READY); - } - - /* * The call to FlushChannel will flush any queued output and invoke the * close function of the channel driver, or it will set up the channel to * be flushed and closed asynchronously. @@ -3967,12 +4076,25 @@ static int WillRead( Channel *chanPtr) { + if (chanPtr->typePtr == NULL) { + /* Prevent read attempts on a closed channel */ + DiscardInputQueued(chanPtr->state, 0); + Tcl_SetErrno(EINVAL); + return -1; + } if ((chanPtr->typePtr->seekProc != NULL) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { - if ((chanPtr->state->curOutPtr != NULL) - && IsBufferReady(chanPtr->state->curOutPtr)) { - SetFlag(chanPtr->state, BUFFER_READY); - } + + /* + * CAVEAT - The assumption here is that FlushChannel() will + * push out the bytes of any writes that are in progress. + * Since this is a seekable channel, we assume it is not one + * that can block and force bg flushing. Channels we know that + * can do that -- sockets, pipes -- are not seekable. If the + * assumption is wrong, more drastic measures may be required here + * like temporarily setting the channel into blocking mode. + */ + if (FlushChannel(NULL, chanPtr, 0) != 0) { return -1; } @@ -4053,6 +4175,7 @@ Write( bufPtr->nextAdded += saved; saved = 0; } + PreserveChannelBuffer(bufPtr); dst = InsertPoint(bufPtr); dstLen = SpaceLeft(bufPtr); @@ -4066,6 +4189,7 @@ Write( if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { /* We're reading from invalid/incomplete UTF-8 */ + ReleaseChannelBuffer(bufPtr); if (total == 0) { Tcl_SetErrno(EINVAL); return -1; @@ -4108,9 +4232,7 @@ Write( &statePtr->outputEncodingState, dst, dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); - if (srcRead != nlLen) { - Tcl_Panic("Can This Happen?"); - } + assert (srcRead == nlLen); bufPtr->nextAdded += dstWrote; src++; @@ -4142,6 +4264,7 @@ Write( if (IsBufferFull(bufPtr)) { if (FlushChannel(NULL, chanPtr, 0) != 0) { + ReleaseChannelBuffer(bufPtr); return -1; } flushed += statePtr->bufSize; @@ -4149,10 +4272,10 @@ Write( needNlFlush = 0; } } + ReleaseChannelBuffer(bufPtr); } if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) || (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) { - SetFlag(statePtr, BUFFER_READY); if (FlushChannel(NULL, chanPtr, 0) != 0) { return -1; } @@ -4240,8 +4363,7 @@ Tcl_GetsObj( Tcl_EncodingState oldState; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - copiedTotal = -1; - goto done; + return -1; } /* @@ -4261,6 +4383,7 @@ Tcl_GetsObj( */ chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); bufPtr = statePtr->inQueueHead; encoding = statePtr->encoding; @@ -4473,6 +4596,7 @@ Tcl_GetsObj( Tcl_SetObjLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); copiedTotal = -1; + ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } goto gotEOL; @@ -4494,7 +4618,11 @@ Tcl_GetsObj( * self-modifying reflected transforms. */ - chanPtr = statePtr->topChanPtr; + if (chanPtr != statePtr->topChanPtr) { + Tcl_Release(chanPtr); + chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); + } bufPtr = gs.bufPtr; if (bufPtr == NULL) { @@ -4528,16 +4656,18 @@ Tcl_GetsObj( * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ - - chanPtr = statePtr->topChanPtr; - + if (chanPtr != statePtr->topChanPtr) { + Tcl_Release(chanPtr); + chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); + } bufPtr = statePtr->inQueueHead; - if (bufPtr == NULL) { - Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL"); + if (bufPtr != NULL) { + bufPtr->nextRemoved = oldRemoved; + bufPtr = bufPtr->nextPtr; } - bufPtr->nextRemoved = oldRemoved; - for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { + for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bufPtr->nextRemoved = BUFFER_PADDING; } CommonGetsCleanup(chanPtr); @@ -4570,10 +4700,13 @@ Tcl_GetsObj( * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ - - chanPtr = statePtr->topChanPtr; - + if (chanPtr != statePtr->topChanPtr) { + Tcl_Release(chanPtr); + chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); + } UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copiedTotal; } @@ -4619,6 +4752,7 @@ TclGetsObjBinary( */ chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); bufPtr = statePtr->inQueueHead; @@ -4666,16 +4800,17 @@ TclGetsObjBinary( * device. Side effect is to allocate another channel buffer. */ - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - goto restore; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); + if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING) + == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) { + goto restore; } if (GetInput(chanPtr) != 0) { goto restore; } bufPtr = statePtr->inQueueTail; + if (bufPtr == NULL) { + goto restore; + } } dst = (unsigned char *) RemovePoint(bufPtr); @@ -4730,6 +4865,7 @@ TclGetsObjBinary( byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); copiedTotal = -1; + ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } goto gotEOL; @@ -4788,12 +4924,12 @@ TclGetsObjBinary( restore: bufPtr = statePtr->inQueueHead; - if (bufPtr == NULL) { - Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL"); + if (bufPtr) { + bufPtr->nextRemoved = oldRemoved; + bufPtr = bufPtr->nextPtr; } - bufPtr->nextRemoved = oldRemoved; - for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { + for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bufPtr->nextRemoved = BUFFER_PADDING; } CommonGetsCleanup(chanPtr); @@ -4822,6 +4958,7 @@ TclGetsObjBinary( done: UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copiedTotal; } @@ -4898,7 +5035,7 @@ FilterInputBytes( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - char *raw, *rawStart, *dst; + char *raw, *dst; int offset, toRead, dstNeeded, spaceLeft, result, rawLen; Tcl_Obj *objPtr; #define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at @@ -4932,14 +5069,6 @@ FilterInputBytes( */ read: - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - gsPtr->charsWrote = 0; - gsPtr->rawRead = 0; - return -1; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); - } if (GetInput(chanPtr) != 0) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; @@ -4947,6 +5076,11 @@ FilterInputBytes( } bufPtr = statePtr->inQueueTail; gsPtr->bufPtr = bufPtr; + if (bufPtr == NULL) { + gsPtr->charsWrote = 0; + gsPtr->rawRead = 0; + return -1; + } } /* @@ -4955,8 +5089,7 @@ FilterInputBytes( * string rep if we need more space. */ - rawStart = RemovePoint(bufPtr); - raw = rawStart; + raw = RemovePoint(bufPtr); rawLen = BytesLeft(bufPtr); dst = *gsPtr->dstPtr; @@ -5023,9 +5156,15 @@ FilterInputBytes( } else { /* * There are no more cached raw bytes left. See if we can get - * some more. + * some more, but avoid blocking on a non-blocking channel. */ + if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) + == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + gsPtr->charsWrote = 0; + gsPtr->rawRead = 0; + return -1; + } goto read; } } else { @@ -5264,134 +5403,77 @@ Tcl_Read( int Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ - char *bufPtr, /* Where to store input read. */ + char *readBuf, /* Where to store input read. */ int bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ - int nread, result, copied, copiedNow; - - /* - * The check below does too much because it will reject a call to this - * function with a channel which is part of an 'fcopy'. But we have to - * allow this here or else the chaining in the transformation drivers will - * fail with 'file busy' error instead of retrieving and transforming the - * data to copy. - * - * We let the check procedure now believe that there is no fcopy in - * progress. A better solution than this might be an additional flag - * argument to switch off specific checks. - */ + int copied = 0; if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { return -1; } - /* - * Check for information in the push-back buffers. If there is some, use - * it. Go to the driver only if there is none (anymore) and the caller - * requests more bytes. - */ + /* First read bytes from the push-back buffers. */ - for (copied = 0; copied < bytesToRead; copied += copiedNow) { - copiedNow = CopyBuffer(chanPtr, bufPtr + copied, - bytesToRead - copied); - if (copiedNow == 0) { - if (GotFlag(statePtr, CHANNEL_EOF)) { - goto done; - } - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - goto done; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); - } + while (chanPtr->inQueueHead && bytesToRead > 0) { + ChannelBuffer *bufPtr = chanPtr->inQueueHead; + int bytesInBuffer = BytesLeft(bufPtr); + int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer + : bytesToRead; -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - /* - * [Bug 943274]. Better emulation of non-blocking channels for - * channels without BlockModeProc, by keeping track of true - * fileevents generated by the OS == Data waiting and reading if - * and only if we are sure to have data. - */ + /* Copy the current chunk into the read buffer. */ - if (GotFlag(statePtr, CHANNEL_NONBLOCKING) && - (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && - !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) { - /* - * We bypass the driver; it would block as no data is - * available. - */ + memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy); + bufPtr->nextRemoved += toCopy; + copied += toCopy; + readBuf += toCopy; + bytesToRead -= toCopy; - nread = -1; - result = EWOULDBLOCK; - } else -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - { - /* - * Now go to the driver to get as much as is possible to fill - * the remaining request. Do all the error handling by - * ourselves. The code was stolen from 'GetInput' and slightly - * adapted (different return value here). - * - * The case of 'bytesToRead == 0' at this point cannot happen. - */ + /* If the current buffer is empty recycle it. */ - nread = ChanRead(chanPtr, bufPtr + copied, - bytesToRead - copied, &result); + if (IsBufferEmpty(bufPtr)) { + chanPtr->inQueueHead = bufPtr->nextPtr; + if (chanPtr->inQueueHead == NULL) { + chanPtr->inQueueTail = NULL; } + RecycleBuffer(chanPtr->state, bufPtr, 0); + } + } - if (nread > 0) { - /* - * If we get a short read, signal up that we may be BLOCKED. - * We should avoid calling the driver because on some - * platforms we will block in the low level reading code even - * though the channel is set into nonblocking mode. - */ + /* Go to the driver if more data needed. */ - if (nread < (bytesToRead - copied)) { - SetFlag(statePtr, CHANNEL_BLOCKED); - } + if (bytesToRead > 0) { -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - if (nread <= (bytesToRead - copied)) { - /* - * [Bug 943274] We have read the available data, clear - * flag. - */ - - ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA); - } -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - } else if (nread == 0) { - SetFlag(statePtr, CHANNEL_EOF); - statePtr->inputEncodingFlags |= TCL_ENCODING_END; - - } else if (nread < 0) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - if (copied > 0) { - /* - * Information that was copied earlier has precedence - * over EAGAIN/WOULDBLOCK handling. - */ - - return copied; - } + int nread = ChanRead(chanPtr, readBuf+copied, bytesToRead); - SetFlag(statePtr, CHANNEL_BLOCKED); - result = EAGAIN; - } - - Tcl_SetErrno(result); - return -1; + if (nread > 0) { + /* Successful read (short is OK) - add to bytes copied */ + copied += nread; + } else if (nread < 0) { + /* + * An error signaled. If CHANNEL_BLOCKED, then the error + * is not real, but an indication of blocked state. In + * that case, retain the flag and let caller receive the + * short read of copied bytes from the pushback. + * HOWEVER, if copied==0 bytes from pushback then repeat + * signalling the blocked state as an error to caller so + * there is no false report of an EOF. + * When !CHANNEL_BLOCKED, the error is real and passes on + * to caller. + */ + if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { + copied = -1; } - - return copied + nread; + } else if (copied > 0) { + /* + * nread == 0. Driver is at EOF, but if copied>0 bytes + * from pushback, then we should not signal it yet. + */ + ResetFlag(statePtr, CHANNEL_EOF); } } - - done: return copied; } @@ -5488,8 +5570,9 @@ DoReadChars( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int offset, factor, copied, copiedNow, result; + int factor, copied, copiedNow, result; Tcl_Encoding encoding; + int binaryMode; #define UTF_EXPANSION_FACTOR 1024 /* @@ -5499,9 +5582,14 @@ DoReadChars( chanPtr = statePtr->topChanPtr; encoding = statePtr->encoding; factor = UTF_EXPANSION_FACTOR; + Tcl_Preserve(chanPtr); + + binaryMode = (encoding == NULL) + && (statePtr->inputTranslation == TCL_TRANSLATE_LF) + && (statePtr->inEofChar == '\0'); if (appendFlag == 0) { - if (encoding == NULL) { + if (binaryMode) { Tcl_SetByteArrayLength(objPtr, 0); } else { Tcl_SetObjLength(objPtr, 0); @@ -5510,27 +5598,23 @@ DoReadChars( * We're going to access objPtr->bytes directly, so we must ensure * that this is actually a string object (otherwise it might have * been pure Unicode). + * + * Probably not needed anymore. */ TclGetString(objPtr); } - offset = 0; - } else { - if (encoding == NULL) { - Tcl_GetByteArrayFromObj(objPtr, &offset); - } else { - TclGetStringFromObj(objPtr, &offset); - } } + /* Must clear the BLOCKED flag here since we check before reading */ + ResetFlag(statePtr, CHANNEL_BLOCKED); for (copied = 0; (unsigned) toRead > 0; ) { copiedNow = -1; if (statePtr->inQueueHead != NULL) { - if (encoding == NULL) { - copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset); + if (binaryMode) { + copiedNow = ReadBytes(statePtr, objPtr, toRead); } else { - copiedNow = ReadChars(statePtr, objPtr, toRead, &offset, - &factor); + copiedNow = ReadChars(statePtr, objPtr, toRead, &factor); } /* @@ -5553,19 +5637,21 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_EOF)) { break; } - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - break; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); + if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) + == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + break; } result = GetInput(chanPtr); + if (chanPtr != statePtr->topChanPtr) { + Tcl_Release(chanPtr); + chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); + } if (result != 0) { - if (result == EAGAIN) { - break; + if (!GotFlag(statePtr, CHANNEL_BLOCKED)) { + copied = -1; } - copied = -1; - goto done; + break; } } else { copied += copiedNow; @@ -5573,27 +5659,31 @@ DoReadChars( } } - ResetFlag(statePtr, CHANNEL_BLOCKED); - if (encoding == NULL) { - Tcl_SetByteArrayLength(objPtr, offset); - } else { - Tcl_SetObjLength(objPtr, offset); - } - /* - * Update the notifier state so we don't block while there is still data - * in the buffers. + * Failure to fill a channel buffer may have left channel reporting + * a "blocked" state, but so long as we fulfilled the request here, + * the caller does not consider us blocked. */ + if (toRead == 0) { + ResetFlag(statePtr, CHANNEL_BLOCKED); + } - done: /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ + if (chanPtr != statePtr->topChanPtr) { + Tcl_Release(chanPtr); + chanPtr = statePtr->topChanPtr; + Tcl_Preserve(chanPtr); + } - chanPtr = statePtr->topChanPtr; - + /* + * Update the notifier state so we don't block while there is still data + * in the buffers. + */ UpdateInterest(chanPtr); + Tcl_Release(chanPtr); return copied; } @@ -5611,13 +5701,11 @@ DoReadChars( * allocated to hold data read from the channel as needed. * * Results: - * The return value is the number of bytes appended to the object and - * *offsetPtr is filled with the total number of bytes in the object - * (greater than the return value if there were already bytes in the - * object). + * The return value is the number of bytes appended to the object, or + * -1 to indicate that zero bytes were read due to an EOF. * * Side effects: - * None. + * The storage of bytes in objPtr can cause (re-)allocation of memory. * *--------------------------------------------------------------------------- */ @@ -5630,72 +5718,22 @@ ReadBytes( * been allocated to hold data, not how many * bytes of data have been stored in the * object. */ - int bytesToRead, /* Maximum number of bytes to store, or < 0 to + int bytesToRead) /* Maximum number of bytes to store, or < 0 to * get all available bytes. Bytes are obtained * from the first buffer in the queue - even * if this number is larger than the number of * bytes available in the first buffer, only * the bytes from the first buffer are * returned. */ - int *offsetPtr) /* On input, contains how many bytes of objPtr - * have been used to hold data. On output, - * filled with how many bytes are now being - * used. */ { - int toRead, srcLen, offset, length, srcRead, dstWrote; - ChannelBuffer *bufPtr; - char *src, *dst; - - offset = *offsetPtr; - - bufPtr = statePtr->inQueueHead; - src = RemovePoint(bufPtr); - srcLen = BytesLeft(bufPtr); - - toRead = bytesToRead; - if ((unsigned) toRead > (unsigned) srcLen) { - toRead = srcLen; - } - - dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length); - if (toRead > length - offset - 1) { - /* - * Double the existing size of the object or make enough room to hold - * all the characters we may get from the source buffer, whichever is - * larger. - */ + ChannelBuffer *bufPtr = statePtr->inQueueHead; + int srcLen = BytesLeft(bufPtr); + int toRead = bytesToRead>srcLen || bytesToRead<0 ? srcLen : bytesToRead; - length = offset * 2; - if (offset < toRead) { - length = offset + toRead + 1; - } - dst = (char *) Tcl_SetByteArrayLength(objPtr, length); - } - dst += offset; - - if (GotFlag(statePtr, INPUT_NEED_NL)) { - ResetFlag(statePtr, INPUT_NEED_NL); - if ((srcLen == 0) || (*src != '\n')) { - *dst = '\r'; - *offsetPtr += 1; - return 1; - } - *dst++ = '\n'; - src++; - srcLen--; - toRead--; - } - - srcRead = srcLen; - dstWrote = toRead; - if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) { - if (dstWrote == 0) { - return -1; - } - } - bufPtr->nextRemoved += srcRead; - *offsetPtr += dstWrote; - return dstWrote; + TclAppendBytesToByteArray(objPtr, (unsigned char *) RemovePoint(bufPtr), + toRead); + bufPtr->nextRemoved += toRead; + return toRead; } /* @@ -5739,262 +5777,351 @@ ReadChars( * is larger than the number of characters * available in the first buffer, only the * characters from the first buffer are - * returned. */ - int *offsetPtr, /* On input, contains how many bytes of objPtr - * have been used to hold data. On output, - * filled with how many bytes are now being - * used. */ + * returned. The execption is when there is + * not any complete character in the first + * buffer. In that case, a recursive call + * effectively obtains chars from the + * second buffer. */ int *factorPtr) /* On input, contains a guess of how many * bytes need to be allocated to hold the * result of converting N source bytes to * UTF-8. On output, contains another guess * based on the data seen so far. */ { - int toRead, factor, offset, spaceLeft, srcLen, dstNeeded; - int srcRead, dstWrote, numChars, dstRead; - ChannelBuffer *bufPtr; - char *src, *dst; - Tcl_EncodingState oldState; - int encEndFlagSuppressed = 0; + Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding + : GetBinaryEncoding(); + Tcl_EncodingState savedState = statePtr->inputEncodingState; + ChannelBuffer *bufPtr = statePtr->inQueueHead; + int savedIEFlags = statePtr->inputEncodingFlags; + int savedFlags = statePtr->flags; + char *dst, *src = RemovePoint(bufPtr); + int dstLimit, numBytes, srcLen = BytesLeft(bufPtr); - factor = *factorPtr; - offset = *offsetPtr; - - bufPtr = statePtr->inQueueHead; - src = RemovePoint(bufPtr); - srcLen = BytesLeft(bufPtr); + /* + * One src byte can yield at most one character. So when the + * number of src bytes we plan to read is less than the limit on + * character count to be read, clearly we will remain within that + * limit, and we can use the value of "srcLen" as a tighter limit + * for sizing receiving buffers. + */ - toRead = charsToRead; - if ((unsigned) toRead > (unsigned) srcLen) { - toRead = srcLen; - } + int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead; /* * 'factor' is how much we guess that the bytes in the source buffer will * expand when converted to UTF-8 chars. This guess comes from analyzing * how many characters were produced by the previous pass. */ + + int factor = *factorPtr; + int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; - dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; - spaceLeft = objPtr->length - offset; - - if (dstNeeded > spaceLeft) { - /* - * Double the existing size of the object or make enough room to hold - * all the characters we want from the source buffer, whichever is - * larger. - */ - - int length = offset + ((offset < dstNeeded) ? dstNeeded : offset); - - if (Tcl_AttemptSetObjLength(objPtr, length) == 0) { - length = offset + dstNeeded; - if (Tcl_AttemptSetObjLength(objPtr, length) == 0) { - dstNeeded = TCL_UTF_MAX - 1 + toRead; - length = offset + dstNeeded; - Tcl_SetObjLength(objPtr, length); - } - } - spaceLeft = length - offset; - } + (void) TclGetStringFromObj(objPtr, &numBytes); + Tcl_AppendToObj(objPtr, NULL, dstNeeded); if (toRead == srcLen) { - /* - * Want to convert the whole buffer in one pass. If we have enough - * space, convert it using all available space in object rather than - * using the factor. - */ - - dstNeeded = spaceLeft; + unsigned int size; + dst = TclGetStringStorage(objPtr, &size) + numBytes; + dstNeeded = size - numBytes; + } else { + dst = TclGetString(objPtr) + numBytes; } - dst = objPtr->bytes + offset; /* - * [Bug 1462248]: The cause of the crash reported in this bug is this: - * - * - ReadChars, called with a single buffer, with a incomplete - * multi-byte character at the end (only the first byte of it). - * - Encoding translation fails, asks for more data - * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set. - * - ReadChar is called again, converts the first buffer, but due to TEE - * it does not check for incomplete multi-byte data, and the character - * just after the end of the first buffer is a valid completion of the - * multi-byte header in the actual buffer. The conversion reads more - * characters from the buffer then present. This causes nextRemoved to - * overshoot nextAdded and the next reads compute a negative srcLen, - * cause further translations to fail, causing copying of data into the - * next buffer using bad arguments, causing the mecpy for to eventually - * fail. + * This routine is burdened with satisfying several constraints. + * It cannot append more than 'charsToRead` chars onto objPtr. + * This is measured after encoding and translation transformations + * are completed. There is no precise number of src bytes that can + * be associated with the limit. Yet, when we are done, we must know + * precisely the number of src bytes that were consumed to produce + * the appended chars, so that all subsequent bytes are left in + * the buffers for future read operations. * - * In the end it is a memory access bug spiraling out of control if the - * conditions are _just so_. And ultimate cause is that TEE is given to a - * conversion where it should not. TEE signals that this is the last - * buffer. Except in our case it is not. - * - * My solution is to suppress TEE if the first buffer is not the last. We - * will eventually need it given that EOF has been reached, but not right - * now. This is what the new flag "endEncSuppressFlag" is for. - * - * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the - * actual buffer has been fixed as well, and fixes the problem with the - * crash too, but this would still allow the generic layer to - * accidentially break a multi-byte sequence if the conditions are just - * right, because again the ExternalToUtf would be successful where it - * should not. + * The consequence is that we have no choice but to implement a + * "trial and error" approach, where in general we may need to + * perform transformations and copies multiple times to achieve + * a consistent set of results. This takes the shape of a loop. */ - if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) && - (bufPtr->nextPtr != NULL)) { + dstLimit = dstNeeded + 1; + while (1) { + int dstDecoded, dstRead, dstWrote, srcRead, numChars; + /* - * TEE is set for a buffer which is not the last. Squash it for now, - * and restore it later, before yielding control to our caller. + * Perform the encoding transformation. Read no more than + * srcLen bytes, write no more than dstLimit bytes. */ - statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - encEndFlagSuppressed = 1; - } + int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, + statePtr->inputEncodingFlags & (bufPtr->nextPtr + ? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState, + dst, dstLimit, &srcRead, &dstDecoded, &numChars); - oldState = statePtr->inputEncodingState; - if (GotFlag(statePtr, INPUT_NEED_NL)) { /* - * We want a '\n' because the last character we saw was '\r'. + * Perform the translation transformation in place. Read no more + * than the dstDecoded bytes the encoding transformation actually + * produced. Capture the number of bytes written in dstWrote. + * Capture the number of bytes actually consumed in dstRead. */ - ResetFlag(statePtr, INPUT_NEED_NL); - Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, - statePtr->inputEncodingFlags, &statePtr->inputEncodingState, - dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars); - if ((dstWrote > 0) && (*dst == '\n')) { + dstWrote = dstLimit; + dstRead = dstDecoded; + TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); + + if (dstRead < dstDecoded) { + /* - * The next char was a '\n'. Consume it and produce a '\n'. + * The encoding transformation produced bytes that the + * translation transformation did not consume. Why did + * this happen? */ - bufPtr->nextRemoved += srcRead; - } else { + if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) { + /* + * 1) There's an eof char set on the channel, and + * we saw it and stopped translating at that point. + * + * NOTE the bizarre spec of TranslateInputEOL in this case. + * Clearly the eof char had to be read in order to account + * for the stopping, but the value of dstRead does not + * include it. + * + * Also rather bizarre, our caller can only notice an + * EOF condition if we return the value -1 as the number + * of chars read. This forces us to perform a 2-call + * dance where the first call can read all the chars + * up to the eof char, and the second call is solely + * for consuming the encoded eof char then pointed at + * by src so that we can return that magic -1 value. + * This seems really wasteful, especially since + * the first decoding pass of each call is likely to + * decode many bytes beyond that eof char that's all we + * care about. + */ + + if (dstRead == 0) { + /* + * Curious choice in the eof char handling. We leave + * the eof char in the buffer. So, no need to compute + * a proper srcRead value. At this point, there + * are no chars before the eof char in the buffer. + */ + Tcl_SetObjLength(objPtr, numBytes); + return -1; + } + + { + /* + * There are chars leading the buffer before the eof + * char. Adjust the dstLimit so we go back and read + * only those and do not encounter the eof char this + * time. + */ + + dstLimit = dstRead + TCL_UTF_MAX; + statePtr->flags = savedFlags; + statePtr->inputEncodingFlags = savedIEFlags; + statePtr->inputEncodingState = savedState; + continue; + } + } + /* - * The next char was not a '\n'. Produce a '\r'. + * 2) The other way to read fewer bytes than are decoded + * is when the final byte is \r and we're in a CRLF + * translation mode so we cannot decide whether to + * record \r or \n yet. */ - *dst = '\r'; - } - statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; - *offsetPtr += 1; + assert(dst[dstRead] == '\r'); + assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF); - if (encEndFlagSuppressed) { - statePtr->inputEncodingFlags |= TCL_ENCODING_END; - } - return 1; - } + if (dstWrote > 0) { + /* + * There are chars we can read before we hit the bare cr. + * Go back with a smaller dstLimit so we get them in the + * next pass, compute a matching srcRead, and don't end + * up back here in this call. + */ - Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, - statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst, - dstNeeded + 1, &srcRead, &dstWrote, &numChars); + dstLimit = dstRead + TCL_UTF_MAX; + statePtr->flags = savedFlags; + statePtr->inputEncodingFlags = savedIEFlags; + statePtr->inputEncodingState = savedState; + continue; + } - if (encEndFlagSuppressed) { - statePtr->inputEncodingFlags |= TCL_ENCODING_END; - } + assert(dstWrote == 0); + assert(dstRead == 0); - if (srcRead == 0) { - /* - * Not enough bytes in src buffer to make a complete char. Copy the - * bytes to the next buffer to make a new contiguous string, then tell - * the caller to fill the buffer with more bytes. - */ + /* + * We decoded only the bare cr, and we cannot read a + * translated char from that alone. We have to know what's + * next. So why do we only have the one decoded char? + */ - ChannelBuffer *nextPtr; + if (code != TCL_OK) { + char buffer[TCL_UTF_MAX + 2]; + int read, decoded, count; + + /* + * Didn't get everything the buffer could offer + */ + + statePtr->flags = savedFlags; + statePtr->inputEncodingFlags = savedIEFlags; + statePtr->inputEncodingState = savedState; + + Tcl_ExternalToUtf(NULL, encoding, src, srcLen, + statePtr->inputEncodingFlags & (bufPtr->nextPtr + ? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState, + buffer, TCL_UTF_MAX + 2, &read, &decoded, &count); + + if (count == 2) { + if (buffer[1] == '\n') { + /* \r\n translate to \n */ + dst[0] = '\n'; + bufPtr->nextRemoved += read; + } else { + dst[0] = '\r'; + bufPtr->nextRemoved += srcRead; + } + + dst[1] = '\0'; + statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; + + Tcl_SetObjLength(objPtr, numBytes + 1); + return 1; + } + + } else if (statePtr->flags & CHANNEL_EOF) { - nextPtr = bufPtr->nextPtr; - if (nextPtr == NULL) { - if (srcLen > 0) { /* - * There isn't enough data in the buffers to complete the next - * character, so we need to wait for more data before the next - * file event can be delivered. [Bug 478856] - * - * The exception to this is if the input buffer was completely - * empty before we tried to convert its contents. Nothing in, - * nothing out, and no incomplete character data. The - * conversion before the current one was complete. + * The bare \r is the only char and we will never read + * a subsequent char to make the determination. */ - SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); + dst[0] = '\r'; + bufPtr->nextRemoved = bufPtr->nextAdded; + Tcl_SetObjLength(objPtr, numBytes + 1); + return 1; } - return -1; + + /* + * Revise the dstRead value so that the numChars calc + * below correctly computes zero characters read. + */ + + dstRead = numChars; + + /* FALL THROUGH - get more data (dstWrote == 0) */ } - /* - * Space is made at the beginning of the buffer to copy the previous - * unused bytes there. Check first if the buffer we are using actually - * has enough space at its beginning for the data we are copying. - * Because if not we will write over the buffer management - * information, especially the 'nextPtr'. - * - * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to - * prevent exactly this situation. I.e. it should never happen. - * Therefore it is ok to panic should it happen despite the - * precautions. + /* + * The translation transformation can only reduce the number + * of chars when it converts \r\n into \n. The reduction in + * the number of chars is the difference in bytes read and written. */ - if (nextPtr->nextRemoved - srcLen < 0) { - Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough"); - } + numChars -= (dstRead - dstWrote); - nextPtr->nextRemoved -= srcLen; - memcpy(RemovePoint(nextPtr), src, (size_t) srcLen); - RecycleBuffer(statePtr, bufPtr, 0); - statePtr->inQueueHead = nextPtr; - return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr); - } + if (charsToRead > 0 && numChars > charsToRead) { - dstRead = dstWrote; - if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) { - /* - * Hit EOF char. How many bytes of src correspond to where the EOF was - * located in dst? Run the conversion again with an output buffer just - * big enough to hold the data so we can get the correct value for - * srcRead. - */ + /* + * We read more chars than allowed. Reset limits to + * prevent that and try again. Don't forget the extra + * padding of TCL_UTF_MAX - 1 bytes demanded by the + * Tcl_ExternalToUtf() call! + */ - if (dstWrote == 0) { - return -1; + dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) + + TCL_UTF_MAX - 1 - dst; + statePtr->flags = savedFlags; + statePtr->inputEncodingFlags = savedIEFlags; + statePtr->inputEncodingState = savedState; + continue; } - statePtr->inputEncodingState = oldState; - Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, - statePtr->inputEncodingFlags, &statePtr->inputEncodingState, - dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); - TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); - } - /* - * The number of characters that we got may be less than the number that - * we started with because "\r\n" sequences may have been turned into just - * '\n' in dst. - */ + if (dstWrote == 0) { + ChannelBuffer *nextPtr; - numChars -= dstRead - dstWrote; + /* We were not able to read any chars. */ - if ((unsigned) numChars > (unsigned) toRead) { - /* - * Got too many chars. - */ + assert (numChars == 0); + + /* + * There is one situation where this is the correct final + * result. If the src buffer contains only a single \n + * byte, and we are in TCL_TRANSLATE_AUTO mode, and + * when the translation pass was made the INPUT_SAW_CR + * flag was set on the channel. In that case, the + * correct behavior is to consume that \n and produce the + * empty string. + */ - const char *eof = Tcl_UtfAtIndex(dst, toRead); + if (dst[0] == '\n') { + assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO); + assert(dstRead == 1); - statePtr->inputEncodingState = oldState; - Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen, - statePtr->inputEncodingFlags, &statePtr->inputEncodingState, - dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); - dstRead = dstWrote; - TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); - numChars -= (dstRead - dstWrote); - } - statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; + goto consume; + } + + /* Otherwise, reading zero characters indicates there's + * something incomplete at the end of the src buffer. + * Maybe there were not enough src bytes to decode into + * a char. Maybe a lone \r could not be translated (crlf + * mode). Need to combine any unused src bytes we have + * in the first buffer with subsequent bytes to try again. + */ + + nextPtr = bufPtr->nextPtr; + + if (nextPtr == NULL) { + if (srcLen > 0) { + SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); + } + Tcl_SetObjLength(objPtr, numBytes); + return -1; + } + + /* + * Space is made at the beginning of the buffer to copy the + * previous unused bytes there. Check first if the buffer we + * are using actually has enough space at its beginning for + * the data we are copying. Because if not we will write over + * the buffer management information, especially the 'nextPtr'. + * + * Note that the BUFFER_PADDING (See AllocChannelBuffer) is + * used to prevent exactly this situation. I.e. it should never + * happen. Therefore it is ok to panic should it happen despite + * the precautions. + */ + + if (nextPtr->nextRemoved - srcLen < 0) { + Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough"); + } + + nextPtr->nextRemoved -= srcLen; + memcpy(RemovePoint(nextPtr), src, (size_t) srcLen); + RecycleBuffer(statePtr, bufPtr, 0); + statePtr->inQueueHead = nextPtr; + Tcl_SetObjLength(objPtr, numBytes); + return ReadChars(statePtr, objPtr, charsToRead, factorPtr); + } + + statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; - bufPtr->nextRemoved += srcRead; - if (dstWrote > srcRead + 1) { - *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead; + consume: + bufPtr->nextRemoved += srcRead; + /* + * If this read contained multibyte characters, revise factorPtr + * so the next read will allocate bigger buffers. + */ + if (numChars && numChars < srcRead) { + *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars; + } + Tcl_SetObjLength(objPtr, numBytes + dstWrote); + return numChars; } - *offsetPtr += dstWrote; - return numChars; } /* @@ -6015,7 +6142,7 @@ ReadChars( *--------------------------------------------------------------------------- */ -static int +static void TranslateInputEOL( ChannelState *statePtr, /* Channel being read, for EOL translation and * EOF character. */ @@ -6024,132 +6151,138 @@ TranslateInputEOL( * characters. */ const char *srcStart, /* Source characters. */ int *dstLenPtr, /* On entry, the maximum length of output - * buffer in bytes; must be <= *srcLenPtr. On - * exit, the number of bytes actually used in - * output buffer. */ + * buffer in bytes. On exit, the number of + * bytes actually used in output buffer. */ int *srcLenPtr) /* On entry, the length of source buffer. On * exit, the number of bytes read from the * source buffer. */ { - int dstLen, srcLen, inEofChar; - const char *eof; + const char *eof = NULL; + int dstLen = *dstLenPtr; + int srcLen = *srcLenPtr; + int inEofChar = statePtr->inEofChar; - dstLen = *dstLenPtr; + /* + * Depending on the translation mode in use, there's no need + * to scan more srcLen bytes at srcStart than can possibly transform + * to dstLen bytes. This keeps the scan for eof char below from + * being pointlessly long. + */ + + switch (statePtr->inputTranslation) { + case TCL_TRANSLATE_LF: + case TCL_TRANSLATE_CR: + if (srcLen > dstLen) { + /* In these modes, each src byte become a dst byte. */ + srcLen = dstLen; + } + break; + default: + /* In other modes, at most 2 src bytes become a dst byte. */ + if (srcLen > 2 * dstLen) { + srcLen = 2 * dstLen; + } + break; + } - eof = NULL; - inEofChar = statePtr->inEofChar; if (inEofChar != '\0') { /* - * Find EOF in translated buffer then compress out the EOL. The source - * buffer may be much longer than the destination buffer - we only - * want to return EOF if the EOF has been copied to the destination - * buffer. + * Make sure we do not read past any logical end of channel input + * created by the presence of the input eof char. */ - const char *src, *srcMax = srcStart + *srcLenPtr; - - for (src = srcStart; src < srcMax; src++) { - if (*src == inEofChar) { - eof = src; - srcLen = src - srcStart; - if (srcLen < dstLen) { - dstLen = srcLen; - } - *srcLenPtr = srcLen; - break; - } + if ((eof = memchr(srcStart, inEofChar, srcLen))) { + srcLen = eof - srcStart; } } + switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: + case TCL_TRANSLATE_CR: if (dstStart != srcStart) { - memcpy(dstStart, srcStart, (size_t) dstLen); + memcpy(dstStart, srcStart, (size_t) srcLen); } - srcLen = dstLen; - break; - case TCL_TRANSLATE_CR: { - char *dst, *dstEnd; + if (statePtr->inputTranslation == TCL_TRANSLATE_CR) { + char *dst = dstStart; + char *dstEnd = dstStart + srcLen; - if (dstStart != srcStart) { - memcpy(dstStart, srcStart, (size_t) dstLen); - } - dstEnd = dstStart + dstLen; - for (dst = dstStart; dst < dstEnd; dst++) { - if (*dst == '\r') { - *dst = '\n'; + while ((dst = memchr(dst, '\r', dstEnd - dst))) { + *dst++ = '\n'; } } - srcLen = dstLen; + dstLen = srcLen; break; - } case TCL_TRANSLATE_CRLF: { - char *dst; - const char *src, *srcEnd, *srcMax; - - dst = dstStart; - src = srcStart; - srcEnd = srcStart + dstLen; - srcMax = srcStart + *srcLenPtr; - - for ( ; src < srcEnd; ) { - if (*src == '\r') { - src++; - if (src >= srcMax) { - SetFlag(statePtr, INPUT_NEED_NL); - } else if (*src == '\n') { - *dst++ = *src++; - } else { + const char *crFound, *src = srcStart; + char *dst = dstStart; + int lesser = (dstLen < srcLen) ? dstLen : srcLen; + + while ((crFound = memchr(src, '\r', lesser))) { + int numBytes = crFound - src; + memmove(dst, src, numBytes); + + dst += numBytes; dstLen -= numBytes; + src += numBytes; srcLen -= numBytes; + if (srcLen == 1) { + /* valid src bytes end in \r */ + if (eof) { *dst++ = '\r'; + src++; srcLen--; + } else { + lesser = 0; + break; } + } else if (src[1] == '\n') { + *dst++ = '\n'; + src += 2; srcLen -= 2; } else { - *dst++ = *src++; + *dst++ = '\r'; + src++; srcLen--; } + dstLen--; + lesser = (dstLen < srcLen) ? dstLen : srcLen; } - srcLen = src - srcStart; - dstLen = dst - dstStart; + memmove(dst, src, lesser); + srcLen = src + lesser - srcStart; + dstLen = dst + lesser - dstStart; break; } case TCL_TRANSLATE_AUTO: { - char *dst; - const char *src, *srcEnd, *srcMax; + const char *crFound, *src = srcStart; + char *dst = dstStart; + int lesser; - dst = dstStart; - src = srcStart; - srcEnd = srcStart + dstLen; - srcMax = srcStart + *srcLenPtr; - - if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) { - if (*src == '\n') { - src++; - } + if ((statePtr->flags & INPUT_SAW_CR) && srcLen) { + if (*src == '\n') { src++; srcLen--; } ResetFlag(statePtr, INPUT_SAW_CR); } - for ( ; src < srcEnd; ) { - if (*src == '\r') { - src++; - if (src >= srcMax) { - SetFlag(statePtr, INPUT_SAW_CR); - } else if (*src == '\n') { - if (srcEnd < srcMax) { - srcEnd++; - } - src++; - } - *dst++ = '\n'; - } else { - *dst++ = *src++; + lesser = (dstLen < srcLen) ? dstLen : srcLen; + while ((crFound = memchr(src, '\r', lesser))) { + int numBytes = crFound - src; + memmove(dst, src, numBytes); + + dst[numBytes] = '\n'; + dst += numBytes + 1; dstLen -= numBytes + 1; + src += numBytes + 1; srcLen -= numBytes + 1; + if (srcLen == 0) { + SetFlag(statePtr, INPUT_SAW_CR); + } else if (*src == '\n') { + src++; srcLen--; } + lesser = (dstLen < srcLen) ? dstLen : srcLen; } - srcLen = src - srcStart; - dstLen = dst - dstStart; + memmove(dst, src, lesser); + srcLen = src + lesser - srcStart; + dstLen = dst + lesser - dstStart; break; } default: - return 0; + Tcl_Panic("unknown input translation %d", statePtr->inputTranslation); } *dstLenPtr = dstLen; + *srcLenPtr = srcLen; - if ((eof != NULL) && (srcStart + srcLen >= eof)) { + if (srcStart + srcLen == eof) { /* * EOF character was seen in EOL translated range. Leave current file * position pointing at the EOF character, but don't store the EOF @@ -6158,12 +6291,8 @@ TranslateInputEOL( SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; - ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL); - return 1; + ResetFlag(statePtr, INPUT_SAW_CR); } - - *srcLenPtr = srcLen; - return 0; } /* @@ -6217,16 +6346,11 @@ Tcl_Ungets( statePtr->flags = flags; /* - * If we have encountered a sticky EOF, just punt without storing (sticky - * EOF is set if we have seen the input eofChar, to prevent reading beyond - * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED - * bit. We want to discover these conditions anew in each operation. + * Clear the EOF flags, and clear the BLOCKED bit. */ - if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { - goto done; - } - ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF); + ResetFlag(statePtr, + CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR); bufPtr = AllocChannelBuffer(len); memcpy(InsertPoint(bufPtr), str, (size_t) len); @@ -6291,14 +6415,6 @@ Tcl_Flush( return -1; } - /* - * Force current output buffer to be output also. - */ - - if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - SetFlag(statePtr, BUFFER_READY); - } - result = FlushChannel(NULL, chanPtr, 0); if (result != 0) { return TCL_ERROR; @@ -6349,7 +6465,7 @@ DiscardInputQueued( */ if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) { - ckfree(statePtr->saveInBufPtr); + ReleaseChannelBuffer(statePtr->saveInBufPtr); statePtr->saveInBufPtr = NULL; } } @@ -6361,6 +6477,9 @@ DiscardInputQueued( * * Reads input data from a device into a channel buffer. * + * IMPORTANT! This routine is only called on a chanPtr argument + * that is the top channel of a stack! + * * Results: * The return value is the Posix error code if an error occurred while * reading from the file, or 0 otherwise. @@ -6393,21 +6512,28 @@ GetInput( return EINVAL; } + /* + * For a channel at EOF do not bother allocating buffers; there's + * nothing more to read. Avoid calling the driver inputproc in + * case some of them do not react well to additional calls after + * they've reported an eof state.. + * TODO: Candidate for a can't happen panic. + */ + + if (GotFlag(statePtr, CHANNEL_EOF)) { + return 0; + } + /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a * transformation which went away without reading all the information * placed in the area when it was stacked. - * - * Two possibilities for the state: No buffers in it, or a single empty - * buffer. In the latter case we can recycle it now. */ if (chanPtr->inQueueHead != NULL) { - if (statePtr->inQueueHead != NULL) { - RecycleBuffer(statePtr, statePtr->inQueueHead, 0); - statePtr->inQueueHead = NULL; - } + + assert(statePtr->inQueueHead == NULL); statePtr->inQueueHead = chanPtr->inQueueHead; statePtr->inQueueTail = chanPtr->inQueueTail; @@ -6428,21 +6554,20 @@ GetInput( */ bufPtr = statePtr->inQueueTail; - if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) { - toRead = SpaceLeft(bufPtr); - } else { + + if ((bufPtr == NULL) || IsBufferFull(bufPtr)) { bufPtr = statePtr->saveInBufPtr; statePtr->saveInBufPtr = NULL; /* * Check the actual buffersize against the requested buffersize. - * Buffers which are smaller than requested are squashed. This is done + * Saved buffers of the wrong size are squashed. This is done * to honor dynamic changes of the buffersize made by the user. */ if ((bufPtr != NULL) - && (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) { - ckfree(bufPtr); + && (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) { + ReleaseChannelBuffer(bufPtr); bufPtr = NULL; } @@ -6451,21 +6576,8 @@ GetInput( } bufPtr->nextPtr = NULL; - /* - * SF #427196: Use the actual size of the buffer to determine the - * number of bytes to read from the channel and not the size for new - * buffers. They can be different if the buffersize was changed - * between reads. - * - * Note: This affects performance negatively if the buffersize was - * extended but this small buffer is reused for all subsequent reads. - * The system never uses buffers with the requested bigger size in - * that case. An adjunct patch could try and delete all unused buffers - * it encounters and which are smaller than the formally requested - * buffersize. - */ - toRead = SpaceLeft(bufPtr); + assert(toRead == statePtr->bufSize); if (statePtr->inQueueTail == NULL) { statePtr->inQueueHead = bufPtr; @@ -6473,75 +6585,22 @@ GetInput( statePtr->inQueueTail->nextPtr = bufPtr; } statePtr->inQueueTail = bufPtr; + } else { + toRead = SpaceLeft(bufPtr); } - /* - * If EOF is set, we should avoid calling the driver because on some - * platforms it is impossible to read from a device after EOF. - */ - - if (GotFlag(statePtr, CHANNEL_EOF)) { - return 0; - } - -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - /* - * [Bug 943274]: Better emulation of non-blocking channels for channels - * without BlockModeProc, by keeping track of true fileevents generated by - * the OS == Data waiting and reading if and only if we are sure to have - * data. - */ - - if (GotFlag(statePtr, CHANNEL_NONBLOCKING) && - (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && - !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) { - /* - * Bypass the driver, it would block, as no data is available - */ + PreserveChannelBuffer(bufPtr); + nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead); - nread = -1; - result = EWOULDBLOCK; - } else -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - { - nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result); - } - - if (nread > 0) { + if (nread < 0) { + result = Tcl_GetErrno(); + } else { + result = 0; bufPtr->nextAdded += nread; - - /* - * If we get a short read, signal up that we may be BLOCKED. We should - * avoid calling the driver because on some platforms we will block in - * the low level reading code even though the channel is set into - * nonblocking mode. - */ - - if (nread < toRead) { - SetFlag(statePtr, CHANNEL_BLOCKED); - } - -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - if (nread <= toRead) { - /* - * [Bug 943274]: We have read the available data, clear flag. - */ - - ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA); - } -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - } else if (nread == 0) { - SetFlag(statePtr, CHANNEL_EOF); - statePtr->inputEncodingFlags |= TCL_ENCODING_END; - } else if (nread < 0) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - SetFlag(statePtr, CHANNEL_BLOCKED); - result = EAGAIN; - } - Tcl_SetErrno(result); - return result; } - return 0; + + ReleaseChannelBuffer(bufPtr); + return result; } /* @@ -6669,15 +6728,6 @@ Tcl_Seek( } /* - * If there is data buffered in statePtr->curOutPtr then mark the channel - * as ready to flush before invoking FlushChannel. - */ - - if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { - SetFlag(statePtr, BUFFER_READY); - } - - /* * If the flush fails we cannot recover the original position. In that * case the seek is not attempted because we do not know where the access * position is - instead we return the error. FlushChannel has already @@ -7001,17 +7051,7 @@ CheckChannelErrors( } if (direction == TCL_READABLE) { - /* - * If we have not encountered a sticky EOF, clear the EOF bit (sticky - * EOF is set if we have seen the input eofChar, to prevent reading - * beyond the eofChar). Also, always clear the BLOCKED bit. We want to - * discover these conditions anew in each operation. - */ - - if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) { - ResetFlag(statePtr, CHANNEL_EOF); - } - ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); + ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } return 0; @@ -7227,7 +7267,27 @@ Tcl_SetChannelBufferSize( } statePtr = ((Channel *) chan)->state; + + if (statePtr->bufSize == sz) { + return; + } statePtr->bufSize = sz; + + /* + * If bufsize changes, need to get rid of old utility buffer. + */ + + if (statePtr->saveInBufPtr != NULL) { + RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1); + statePtr->saveInBufPtr = NULL; + } + if ((statePtr->inQueueHead != NULL) + && (statePtr->inQueueHead->nextPtr == NULL) + && IsBufferEmpty(statePtr->inQueueHead)) { + RecycleBuffer(statePtr, statePtr->inQueueHead, 1); + statePtr->inQueueHead = NULL; + statePtr->inQueueTail = NULL; + } } /* @@ -7662,6 +7722,7 @@ Tcl_SetChannelOption( return TCL_ERROR; } Tcl_SetChannelBufferSize(chan, newBufferSize); + return TCL_OK; } else if (HaveOpt(2, "-encoding")) { Tcl_Encoding encoding; @@ -7679,7 +7740,8 @@ Tcl_SetChannelOption( * iso2022, the terminated escape sequence must write to the buffer. */ - if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) + if ((statePtr->encoding != NULL) + && !(statePtr->outputEncodingFlags & TCL_ENCODING_START) && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; WriteChars(chanPtr, "", 0); @@ -7692,6 +7754,7 @@ Tcl_SetChannelOption( statePtr->outputEncodingFlags = TCL_ENCODING_START; ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); UpdateInterest(chanPtr); + return TCL_OK; } else if (HaveOpt(2, "-eofchar")) { if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -7852,22 +7915,6 @@ Tcl_SetChannelOption( return Tcl_BadChannelOption(interp, optionName, NULL); } - /* - * If bufsize changes, need to get rid of old utility buffer. - */ - - if (statePtr->saveInBufPtr != NULL) { - RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1); - statePtr->saveInBufPtr = NULL; - } - if ((statePtr->inQueueHead != NULL) - && (statePtr->inQueueHead->nextPtr == NULL) - && IsBufferEmpty(statePtr->inQueueHead)) { - RecycleBuffer(statePtr, statePtr->inQueueHead, 1); - statePtr->inQueueHead = NULL; - statePtr->inQueueTail = NULL; - } - return TCL_OK; } @@ -7959,21 +8006,6 @@ Tcl_NotifyChannel( Channel *upChanPtr; const Tcl_ChannelType *upTypePtr; -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - /* - * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we - * keep track of actual input coming from the OS so that we can do a - * credible imitation of non-blocking behaviour. - */ - - if ((mask & TCL_READABLE) && - GotFlag(statePtr, CHANNEL_NONBLOCKING) && - (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && - !GotFlag(statePtr, CHANNEL_TIMER_FEV)) { - SetFlag(statePtr, CHANNEL_HAS_MORE_DATA); - } -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - /* * In contrast to the other API functions this procedure walks towards the * top of a stack and not down from it. @@ -8033,8 +8065,9 @@ Tcl_NotifyChannel( */ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { - FlushChannel(NULL, chanPtr, 1); - mask &= ~TCL_WRITABLE; + if (0 == FlushChannel(NULL, chanPtr, 1)) { + mask &= ~TCL_WRITABLE; + } } /* @@ -8102,6 +8135,11 @@ UpdateInterest( /* State info for channel */ int mask = statePtr->interestMask; + if (chanPtr->typePtr == NULL) { + /* Do not update interest on a closed channel */ + return; + } + /* * If there are flushed buffers waiting to be written, then we need to * watch for the channel to become writable. @@ -8209,29 +8247,8 @@ ChannelTimerProc( statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc,chanPtr); - -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - /* - * Set the TIMER flag to notify the higher levels that the driver - * might have no data for us. We do this only if we are in - * non-blocking mode and the driver has no BlockModeProc because only - * then we really don't know if the driver will block or not. A - * similar test is done in "PeekAhead". - */ - - if (GotFlag(statePtr, CHANNEL_NONBLOCKING) && - (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) { - SetFlag(statePtr, CHANNEL_TIMER_FEV); - } -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - Tcl_Preserve(statePtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); - -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - ResetFlag(statePtr, CHANNEL_TIMER_FEV); -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - Tcl_Release(statePtr); } else { statePtr->timer = NULL; @@ -9171,12 +9188,23 @@ CopyData( * * DoRead -- * - * Reads a given number of bytes from a channel. No encoding conversions + * Stores up to "bytesToRead" bytes in memory pointed to by "dst". + * These bytes come from reading the channel "chanPtr" and + * performing the configured translations. No encoding conversions * are applied to the bytes being read. * * Results: - * The number of characters read, or -1 on error. Use Tcl_GetErrno() to - * retrieve the error code for the error that occurred. + * The number of bytes actually stored (<= bytesToRead), + * or -1 if there is an error in reading the channel. Use + * Tcl_GetErrno() to retrieve the error code for the error + * that occurred. + * + * The number of bytes stored can be less than the number + * requested when + * - EOF is reached on the channel; or + * - the channel is non-blocking, and we've read all we can + * without blocking. + * - a channel reading error occurs (and we return -1) * * Side effects: * May cause input to be buffered. @@ -9187,382 +9215,152 @@ CopyData( static int DoRead( Channel *chanPtr, /* The channel from which to read. */ - char *bufPtr, /* Where to store input read. */ - int toRead, /* Maximum number of bytes to read. */ + char *dst, /* Where to store input read. */ + int bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; - /* State info for channel */ - int copied; /* How many characters were copied into the - * result string? */ - int copiedNow; /* How many characters were copied from the - * current input buffer? */ - int result; /* Of calling GetInput. */ - - /* - * If we have not encountered a sticky EOF, clear the EOF bit. Either way - * clear the BLOCKED bit. We want to discover these anew during each - * operation. - */ - - if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) { - ResetFlag(statePtr, CHANNEL_EOF); - } - ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); - - for (copied = 0; copied < toRead; copied += copiedNow) { - copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied, - toRead - copied); - if (copiedNow == 0) { - if (GotFlag(statePtr, CHANNEL_EOF)) { - goto done; - } - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - goto done; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); - } - result = GetInput(chanPtr); - if (result != 0) { - if (result != EAGAIN) { - copied = -1; - } - goto done; - } - } else if (allowShortReads) { - copied += copiedNow; - break; - } - } - - ResetFlag(statePtr, CHANNEL_BLOCKED); - - /* - * Update the notifier state so we don't block while there is still data - * in the buffers. - */ - - done: - UpdateInterest(chanPtr); - return copied; -} - -/* - *---------------------------------------------------------------------- - * - * CopyAndTranslateBuffer -- - * - * Copy at most one buffer of input to the result space, doing eol - * translations according to mode in effect currently. - * - * Results: - * Number of bytes stored in the result buffer (as opposed to the number - * of bytes read from the channel). May return zero if no input is - * available to be translated. - * - * Side effects: - * Consumes buffered input. May deallocate one buffer. - * - *---------------------------------------------------------------------- - */ - -static int -CopyAndTranslateBuffer( - ChannelState *statePtr, /* Channel state from which to read input. */ - char *result, /* Where to store the copied input. */ - int space) /* How many bytes are available in result to - * store the copied input? */ -{ - ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */ - int bytesInBuffer; /* How many bytes are available to be copied - * in the current input buffer? */ - int copied; /* How many characters were already copied - * into the destination space? */ - int i; /* Iterates over the copied input looking for - * the input eofChar. */ - - /* - * If there is no input at all, return zero. The invariant is that either - * there is no buffer in the queue, or if the first buffer is empty, it is - * also the last buffer (and thus there is no input in the queue). Note - * also that if the buffer is empty, we leave it in the queue. - */ - - if (statePtr->inQueueHead == NULL) { - return 0; - } - bufPtr = statePtr->inQueueHead; - bytesInBuffer = BytesLeft(bufPtr); - - copied = 0; - switch (statePtr->inputTranslation) { - case TCL_TRANSLATE_LF: - if (bytesInBuffer == 0) { - return 0; - } + char *p = dst; + Tcl_Preserve(chanPtr); + while (bytesToRead) { /* - * Copy the current chunk into the result buffer. + * Each pass through the loop is intended to process up to + * one channel buffer. */ - if (bytesInBuffer < space) { - space = bytesInBuffer; - } - memcpy(result, RemovePoint(bufPtr), (size_t) space); - bufPtr->nextRemoved += space; - copied = space; - break; - case TCL_TRANSLATE_CR: { - char *end; - - if (bytesInBuffer == 0) { - return 0; - } + int bytesRead, bytesWritten; + ChannelBuffer *bufPtr = statePtr->inQueueHead; /* - * Copy the current chunk into the result buffer, then replace all \r - * with \n. + * When there's no buffered data to read, and we're at EOF, + * escape to the caller. */ - if (bytesInBuffer < space) { - space = bytesInBuffer; - } - memcpy(result, RemovePoint(bufPtr), (size_t) space); - bufPtr->nextRemoved += space; - copied = space; - - for (end = result + copied; result < end; result++) { - if (*result == '\r') { - *result = '\n'; - } + if (statePtr->flags & CHANNEL_EOF + && (bufPtr == NULL || IsBufferEmpty(bufPtr))) { + break; } - break; - } - case TCL_TRANSLATE_CRLF: { - char *src, *end, *dst; - int curByte; - /* - * If there is a held-back "\r" at EOF, produce it now. - */ + /* If there is no full buffer, attempt to create and/or fill one. */ - if (bytesInBuffer == 0) { - if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) == - (INPUT_SAW_CR | CHANNEL_EOF)) { - result[0] = '\r'; - ResetFlag(statePtr, INPUT_SAW_CR); - return 1; - } - return 0; - } + while (!IsBufferFull(bufPtr)) { + int code; - /* - * Copy the current chunk and replace "\r\n" with "\n" (but not - * standalone "\r"!). - */ + moreData: + code = GetInput(chanPtr); + bufPtr = statePtr->inQueueHead; - if (bytesInBuffer < space) { - space = bytesInBuffer; - } - memcpy(result, RemovePoint(bufPtr), (size_t) space); - bufPtr->nextRemoved += space; - copied = space; + assert (bufPtr != NULL); - end = result + copied; - dst = result; - for (src = result; src < end; src++) { - curByte = *src; - if (curByte == '\n') { - ResetFlag(statePtr, INPUT_SAW_CR); - } else if (GotFlag(statePtr, INPUT_SAW_CR)) { - ResetFlag(statePtr, INPUT_SAW_CR); - *dst = '\r'; - dst++; + if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) { + /* Further reads cannot do any more */ + break; } - if (curByte == '\r') { - SetFlag(statePtr, INPUT_SAW_CR); - } else { - *dst = (char) curByte; - dst++; + + if (code) { + /* Read error */ + UpdateInterest(chanPtr); + Tcl_Release(chanPtr); + return -1; } - } - copied = dst - result; - break; - } - case TCL_TRANSLATE_AUTO: { - char *src, *end, *dst; - int curByte; - if (bytesInBuffer == 0) { - return 0; + assert (IsBufferFull(bufPtr)); } - /* - * Loop over the current buffer, converting "\r" and "\r\n" to "\n". - */ + assert (bufPtr != NULL); - if (bytesInBuffer < space) { - space = bytesInBuffer; - } - memcpy(result, RemovePoint(bufPtr), (size_t) space); - bufPtr->nextRemoved += space; - copied = space; + bytesRead = BytesLeft(bufPtr); + bytesWritten = bytesToRead; - end = result + copied; - dst = result; - for (src = result; src < end; src++) { - curByte = *src; - if (curByte == '\r') { - SetFlag(statePtr, INPUT_SAW_CR); - *dst = '\n'; - dst++; - } else { - if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) { - *dst = (char) curByte; - dst++; - } - ResetFlag(statePtr, INPUT_SAW_CR); - } - } - copied = dst - result; - break; - } - default: - Tcl_Panic("unknown eol translation mode"); - } - - /* - * If an in-stream EOF character is set for this channel, check that the - * input we copied so far does not contain the EOF char. If it does, copy - * only up to and excluding that character. - */ + TranslateInputEOL(statePtr, p, RemovePoint(bufPtr), + &bytesWritten, &bytesRead); + bufPtr->nextRemoved += bytesRead; + p += bytesWritten; + bytesToRead -= bytesWritten; - if (statePtr->inEofChar != 0) { - for (i = 0; i < copied; i++) { - if (result[i] == (char) statePtr->inEofChar) { - /* - * Set sticky EOF so that no further input is presented to the - * caller. - */ + if (!IsBufferEmpty(bufPtr)) { + /* + * Buffer is not empty. How can that be? + * + * 0) We stopped early because we got all the bytes + * we were seeking. That's fine. + */ - SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); - statePtr->inputEncodingFlags |= TCL_ENCODING_END; - copied = i; + if (bytesToRead == 0) { + UpdateInterest(chanPtr); break; } - } - } - - /* - * If the current buffer is empty recycle it. - */ - - if (IsBufferEmpty(bufPtr)) { - statePtr->inQueueHead = bufPtr->nextPtr; - if (statePtr->inQueueHead == NULL) { - statePtr->inQueueTail = NULL; - } - RecycleBuffer(statePtr, bufPtr, 0); - } - - /* - * Return the number of characters copied into the result buffer. This may - * be different from the number of bytes consumed, because of EOL - * translations. - */ - return copied; -} - -/* - *---------------------------------------------------------------------- - * - * CopyBuffer -- - * - * Copy at most one buffer of input to the result space. - * - * Results: - * Number of bytes stored in the result buffer. May return zero if no - * input is available. - * - * Side effects: - * Consumes buffered input. May deallocate one buffer. - * - *---------------------------------------------------------------------- - */ + /* + * 1) We're @EOF because we saw eof char. + */ -static int -CopyBuffer( - Channel *chanPtr, /* Channel from which to read input. */ - char *result, /* Where to store the copied input. */ - int space) /* How many bytes are available in result to - * store the copied input? */ -{ - ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */ - int bytesInBuffer; /* How many bytes are available to be copied - * in the current input buffer? */ - int copied; /* How many characters were already copied - * into the destination space? */ + if (statePtr->inEofChar + && RemovePoint(bufPtr)[0] == statePtr->inEofChar) { + UpdateInterest(chanPtr); + break; + } - /* - * If there is no input at all, return zero. The invariant is that either - * there is no buffer in the queue, or if the first buffer is empty, it is - * also the last buffer (and thus there is no input in the queue). Note - * also that if the buffer is empty, we don't leave it in the queue, but - * recycle it. - */ + /* + * 2) The buffer holds a \r while in CRLF translation, + * followed by the end of the buffer. + */ - if (chanPtr->inQueueHead == NULL) { - return 0; - } - bufPtr = chanPtr->inQueueHead; - bytesInBuffer = BytesLeft(bufPtr); + assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF); + assert(RemovePoint(bufPtr)[0] == '\r'); + assert(BytesLeft(bufPtr) == 1); - copied = 0; + if (bufPtr->nextPtr == NULL) { + /* There's no more buffered data.... */ - if (bytesInBuffer == 0) { - RecycleBuffer(chanPtr->state, bufPtr, 0); - chanPtr->inQueueHead = NULL; - chanPtr->inQueueTail = NULL; - return 0; - } + if (statePtr->flags & CHANNEL_EOF) { + /* ...and there never will be. */ - /* - * Copy the current chunk into the result buffer. - */ + *p++ = '\r'; + bytesToRead--; + bufPtr->nextRemoved++; + } else if (statePtr->flags & CHANNEL_BLOCKED) { + /* ...and we cannot get more now. */ + SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); + UpdateInterest(chanPtr); + break; + } else { + /* ... so we need to get some. */ + goto moreData; + } + } - if (bytesInBuffer < space) { - space = bytesInBuffer; - } + if (bufPtr->nextPtr) { + /* There's a next buffer. Shift orphan \r to it. */ - memcpy(result, RemovePoint(bufPtr), (size_t) space); - bufPtr->nextRemoved += space; - copied = space; + ChannelBuffer *nextPtr = bufPtr->nextPtr; - /* - * We don't care about in-stream EOF characters here as the data read here - * may still flow through one or more transformations, i.e. is not in its - * final state yet. - */ + nextPtr->nextRemoved -= 1; + RemovePoint(nextPtr)[0] = '\r'; + bufPtr->nextRemoved++; + } + } - /* - * If the current buffer is empty recycle it. - */ + if (IsBufferEmpty(bufPtr)) { + statePtr->inQueueHead = bufPtr->nextPtr; + if (statePtr->inQueueHead == NULL) { + statePtr->inQueueTail = NULL; + } + RecycleBuffer(statePtr, bufPtr, 0); + } - if (IsBufferEmpty(bufPtr)) { - chanPtr->inQueueHead = bufPtr->nextPtr; - if (chanPtr->inQueueHead == NULL) { - chanPtr->inQueueTail = NULL; + if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads) + && GotFlag(statePtr, CHANNEL_BLOCKED)) { + break; } - RecycleBuffer(chanPtr->state, bufPtr, 0); + } + if (bytesToRead == 0) { + ResetFlag(statePtr, CHANNEL_BLOCKED); } - /* - * Return the number of characters copied into the result buffer. - */ - - return copied; + Tcl_Release(chanPtr); + return (int)(p - dst); } /* @@ -9682,12 +9480,15 @@ StackSetBlockMode( { int result = 0; Tcl_DriverBlockModeProc *blockModeProc; + ChannelState *statePtr = chanPtr->state; /* * Start at the top of the channel stack + * TODO: Examine what can go wrong when blockModeProc calls + * disturb the stacking state of the channel. */ - chanPtr = chanPtr->state->topChanPtr; + chanPtr = statePtr->topChanPtr; while (chanPtr != NULL) { blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr); if (blockModeProc != NULL) { @@ -10826,6 +10627,7 @@ SetChannelFromAny( } if (objPtr->typePtr == &chanObjType) { /* + * TODO: TAINT Flag and dup'd channel values? * The channel is valid until any call to DetachChannel occurs. * Ensure consistency checks are done. */ @@ -10902,20 +10704,14 @@ DumpFlags( ChanFlag('n', CHANNEL_NONBLOCKING); ChanFlag('l', CHANNEL_LINEBUFFERED); ChanFlag('u', CHANNEL_UNBUFFERED); - ChanFlag('R', BUFFER_READY); ChanFlag('F', BG_FLUSH_SCHEDULED); ChanFlag('c', CHANNEL_CLOSED); ChanFlag('E', CHANNEL_EOF); ChanFlag('S', CHANNEL_STICKY_EOF); ChanFlag('B', CHANNEL_BLOCKED); ChanFlag('/', INPUT_SAW_CR); - ChanFlag('*', INPUT_NEED_NL); ChanFlag('D', CHANNEL_DEAD); ChanFlag('R', CHANNEL_RAW_MODE); -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - ChanFlag('T', CHANNEL_TIMER_FEV); - ChanFlag('H', CHANNEL_HAS_MORE_DATA); -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ ChanFlag('x', CHANNEL_INCLOSE); buf[i] ='\0'; diff --git a/generic/tclIO.h b/generic/tclIO.h index e84f300..097cd61 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -36,6 +36,7 @@ */ typedef struct ChannelBuffer { + int refCount; /* Current uses count */ int nextAdded; /* The next position into which a character * will be put in the buffer. */ int nextRemoved; /* Position of next byte to be removed from @@ -226,11 +227,6 @@ typedef struct ChannelState { * flushed after every newline. */ #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always * be flushed immediately. */ -#define BUFFER_READY (1<<6) /* Current output buffer (the - * curOutPtr field in the channel - * structure) should be output as soon - * as possible even though it may not - * be full. */ #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued * output buffers has been * scheduled. */ @@ -252,9 +248,6 @@ typedef struct ChannelState { #define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input * translation mode and the last byte * seen was a "\r". */ -#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer, - * and there should be a '\n' at - * beginning of next buffer. */ #define CHANNEL_DEAD (1<<13) /* The channel has been closed by the * exit handler (on exit) but not * deallocated. When any IO operation @@ -274,29 +267,6 @@ typedef struct ChannelState { * changes. */ #define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is * being used. */ -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING -#define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are notified - * by is a fileevent generated by a - * timer. We don't know if the driver - * has more data and should not try to - * read from it. If the system needs - * more than is in the buffers out - * read routines will simulate a short - * read (0 characters read) */ -#define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a channel - * if and only if the channel is - * configured non-blocking, the driver - * for said channel has no - * blockmodeproc, and data has arrived - * for reading at the OS level). A - * GetInput will pass reading from the - * driver if the channel is - * non-blocking, without blockmode - * proc and the flag has not been set. - * A read will be performed if the - * flag is set. This will reset the - * flag as well. */ -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ #define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed. * Its structures are still live and diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 1673bce..3368a76 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -181,6 +181,7 @@ Tcl_PutsObjCmd( return TCL_ERROR; } + Tcl_Preserve(chan); result = Tcl_WriteObj(chan, string); if (result < 0) { goto error; @@ -191,6 +192,7 @@ Tcl_PutsObjCmd( goto error; } } + Tcl_Release(chan); return TCL_OK; /* @@ -205,6 +207,7 @@ Tcl_PutsObjCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } + Tcl_Release(chan); return TCL_ERROR; } @@ -252,6 +255,7 @@ Tcl_FlushObjCmd( return TCL_ERROR; } + Tcl_Preserve(chan); if (Tcl_Flush(chan) != TCL_OK) { /* * TIP #219. @@ -265,8 +269,10 @@ Tcl_FlushObjCmd( "error flushing \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } + Tcl_Release(chan); return TCL_ERROR; } + Tcl_Release(chan); return TCL_OK; } @@ -299,6 +305,7 @@ Tcl_GetsObjCmd( int lineLen; /* Length of line just read. */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *linePtr, *chanObjPtr; + int code = TCL_OK; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?"); @@ -315,6 +322,7 @@ Tcl_GetsObjCmd( return TCL_ERROR; } + Tcl_Preserve(chan); linePtr = Tcl_NewObj(); lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { @@ -333,20 +341,24 @@ Tcl_GetsObjCmd( "error reading \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } - return TCL_ERROR; + code = TCL_ERROR; + goto done; } lineLen = -1; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, TCL_LEAVE_ERR_MSG) == NULL) { - return TCL_ERROR; + code = TCL_ERROR; + goto done; } Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen)); } else { Tcl_SetObjResult(interp, linePtr); } - return TCL_OK; + done: + Tcl_Release(chan); + return code; } /* @@ -453,6 +465,7 @@ Tcl_ReadObjCmd( resultPtr = Tcl_NewObj(); Tcl_IncrRefCount(resultPtr); + Tcl_Preserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead < 0) { /* @@ -467,6 +480,7 @@ Tcl_ReadObjCmd( "error reading \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } + Tcl_Release(chan); Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } @@ -485,6 +499,7 @@ Tcl_ReadObjCmd( } } Tcl_SetObjResult(interp, resultPtr); + Tcl_Release(chan); Tcl_DecrRefCount(resultPtr); return TCL_OK; } @@ -544,6 +559,7 @@ Tcl_SeekObjCmd( mode = modeArray[optionIndex]; } + Tcl_Preserve(chan); result = Tcl_Seek(chan, offset, mode); if (result == Tcl_LongAsWide(-1)) { /* @@ -558,8 +574,10 @@ Tcl_SeekObjCmd( "error during seek on \"%s\": %s", TclGetString(objv[1]), Tcl_PosixError(interp))); } + Tcl_Release(chan); return TCL_ERROR; } + Tcl_Release(chan); return TCL_OK; } @@ -590,6 +608,7 @@ Tcl_TellObjCmd( { Tcl_Channel chan; /* The channel to tell on. */ Tcl_WideInt newLoc; + int code; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); @@ -605,6 +624,7 @@ Tcl_TellObjCmd( return TCL_ERROR; } + Tcl_Preserve(chan); newLoc = Tcl_Tell(chan); /* @@ -613,7 +633,10 @@ Tcl_TellObjCmd( * them into the regular interpreter result. */ - if (TclChanCaughtErrorBypass(interp, chan)) { + + code = TclChanCaughtErrorBypass(interp, chan); + Tcl_Release(chan); + if (code) { return TCL_ERROR; } @@ -896,7 +919,7 @@ Tcl_ExecObjCmd( if (string[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch", + if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } @@ -910,7 +933,7 @@ Tcl_ExecObjCmd( } } if (objc <= skip) { - Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? arg ?arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?"); return TCL_ERROR; } @@ -1673,7 +1696,7 @@ Tcl_FcopyObjCmd( toRead = -1; cmdPtr = NULL; for (i = 3; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0, + if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 825f408..9c4347d 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -210,7 +210,27 @@ struct TransformChannelData { * a transformation of incoming data. Also * serves as buffer of all data not yet * consumed by the reader. */ + int refCount; }; + +static void +PreserveData( + TransformChannelData *dataPtr) +{ + dataPtr->refCount++; +} + +static void +ReleaseData( + TransformChannelData *dataPtr) +{ + if (--dataPtr->refCount) { + return; + } + ResultClear(&dataPtr->result); + Tcl_DecrRefCount(dataPtr->command); + ckfree(dataPtr); +} /* *---------------------------------------------------------------------- @@ -240,6 +260,7 @@ TclChannelTransform( Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* State info for channel. */ int mode; /* Read/write mode of the channel. */ + int objc; TransformChannelData *dataPtr; Tcl_DString ds; @@ -247,6 +268,12 @@ TclChannelTransform( return TCL_ERROR; } + if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("-command value is not a list", -1)); + return TCL_ERROR; + } + chanPtr = (Channel *) chan; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; @@ -261,6 +288,7 @@ TclChannelTransform( dataPtr = ckalloc(sizeof(TransformChannelData)); + dataPtr->refCount = 1; Tcl_DStringInit(&ds); Tcl_GetChannelOption(interp, chan, "-blocking", &ds); dataPtr->readIsFlushed = 0; @@ -270,7 +298,6 @@ TclChannelTransform( } Tcl_DStringFree(&ds); - dataPtr->self = chan; dataPtr->watchMask = 0; dataPtr->mode = mode; dataPtr->timer = NULL; @@ -286,19 +313,20 @@ TclChannelTransform( if (dataPtr->self == NULL) { Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan)); - Tcl_DecrRefCount(dataPtr->command); - ResultClear(&dataPtr->result); - ckfree(dataPtr); + ReleaseData(dataPtr); return TCL_ERROR; } + Tcl_Preserve(dataPtr->self); /* * At last initialize the transformation at the script level. */ + PreserveData(dataPtr); if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL, A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){ Tcl_UnstackChannel(interp, chan); + ReleaseData(dataPtr); return TCL_ERROR; } @@ -307,9 +335,11 @@ TclChannelTransform( ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE); Tcl_UnstackChannel(interp, chan); + ReleaseData(dataPtr); return TCL_ERROR; } + ReleaseData(dataPtr); return TCL_OK; } @@ -350,7 +380,10 @@ ExecuteCallback( unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; - Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command); + Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command); + Tcl_Interp *eval = dataPtr->interp; + + Tcl_Preserve(eval); /* * Step 1, create the complete command to execute. Do this by appending @@ -361,26 +394,18 @@ ExecuteCallback( */ if (preserve == P_PRESERVE) { - state = Tcl_SaveInterpState(dataPtr->interp, res); + state = Tcl_SaveInterpState(eval, res); } Tcl_IncrRefCount(command); - res = Tcl_ListObjAppendElement(dataPtr->interp, command, - Tcl_NewStringObj((char *) op, -1)); - if (res != TCL_OK) { - goto cleanup; - } + Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1)); /* * Use a byte-array to prevent the misinterpretation of binary data coming * through as UTF while at the tcl level. */ - res = Tcl_ListObjAppendElement(dataPtr->interp, command, - Tcl_NewByteArrayObj(buf, bufLen)); - if (res != TCL_OK) { - goto cleanup; - } + Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen)); /* * Step 2, execute the command at the global level of the interpreter used @@ -390,13 +415,14 @@ ExecuteCallback( * current interpreter. Don't copy if in preservation mode. */ - res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL); + res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(command); command = NULL; - if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp) + if ((res != TCL_OK) && (interp != NULL) && (eval != interp) && (preserve == P_NO_PRESERVE)) { - Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp)); + Tcl_SetObjResult(interp, Tcl_GetObjResult(eval)); + Tcl_Release(eval); return res; } @@ -411,20 +437,26 @@ ExecuteCallback( break; case TRANSMIT_DOWN: - resObj = Tcl_GetObjResult(dataPtr->interp); + if (dataPtr->self == NULL) { + break; + } + resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; case TRANSMIT_SELF: - resObj = Tcl_GetObjResult(dataPtr->interp); + if (dataPtr->self == NULL) { + break; + } + resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: - resObj = Tcl_GetObjResult(dataPtr->interp); + resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; @@ -434,24 +466,16 @@ ExecuteCallback( * Interpret result as integer number. */ - resObj = Tcl_GetObjResult(dataPtr->interp); - TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead); + resObj = Tcl_GetObjResult(eval); + TclGetIntFromObj(eval, resObj, &dataPtr->maxRead); break; } - Tcl_ResetResult(dataPtr->interp); + Tcl_ResetResult(eval); if (preserve == P_PRESERVE) { - (void) Tcl_RestoreInterpState(dataPtr->interp, state); - } - return res; - - cleanup: - if (preserve == P_PRESERVE) { - (void) Tcl_RestoreInterpState(dataPtr->interp, state); - } - if (command != NULL) { - Tcl_DecrRefCount(command); + (void) Tcl_RestoreInterpState(eval, state); } + Tcl_Release(eval); return res; } @@ -535,6 +559,7 @@ TransformCloseProc( * system rely on (f.e. signaling the close to interested parties). */ + PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_PRESERVE); @@ -554,14 +579,15 @@ TransformCloseProc( ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0, TRANSMIT_DONT, P_PRESERVE); } + ReleaseData(dataPtr); /* * General cleanup. */ - ResultClear(&dataPtr->result); - Tcl_DecrRefCount(dataPtr->command); - ckfree(dataPtr); + Tcl_Release(dataPtr->self); + dataPtr->self = NULL; + ReleaseData(dataPtr); return TCL_OK; } @@ -596,7 +622,7 @@ TransformInputProc( * Should assert(dataPtr->mode & TCL_READABLE); */ - if (toRead == 0) { + if (toRead == 0 || dataPtr->self == NULL) { /* * Catch a no-op. */ @@ -606,6 +632,7 @@ TransformInputProc( gotBytes = 0; downChan = Tcl_GetStackedChannel(dataPtr->self); + PreserveData(dataPtr); while (toRead > 0) { /* * Loop until the request is satisfied (or no data is available from @@ -623,7 +650,7 @@ TransformInputProc( * break out of the loop and return to the caller. */ - return gotBytes; + break; } /* @@ -647,7 +674,7 @@ TransformInputProc( } } /* else: 'maxRead < 0' == Accept the current value of toRead. */ if (toRead <= 0) { - return gotBytes; + break; } /* @@ -656,44 +683,40 @@ TransformInputProc( read = Tcl_ReadRaw(downChan, buf, toRead); if (read < 0) { - /* - * Report errors to caller. EAGAIN is a special situation. If we - * had some data before we report that instead of the request to - * re-try. - */ - int error = Tcl_GetErrno(); + if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) { + /* + * Zero bytes available from downChan because blocked. + * But nonzero bytes already copied, so total is a + * valid blocked short read. Return to caller. + */ - if ((error == EAGAIN) && (gotBytes > 0)) { - return gotBytes; + break; } - *errorCodePtr = error; - return -1; - } else if (read == 0) { /* - * Check wether we hit on EOF in the underlying channel 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. + * Either downChan is not blocked (there's a real error). + * or it is and there are no bytes copied yet. In either + * case we want to pass the "error" along to the caller, + * either to report an error, or to signal to the caller + * that zero bytes are available because blocked. */ - if (!Tcl_Eof(downChan)) { - if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) { - *errorCodePtr = EWOULDBLOCK; - return -1; - } - return gotBytes; - } + *errorCodePtr = Tcl_GetErrno(); + gotBytes = -1; + break; + } else if (read == 0) { + + /* + * Zero returned from Tcl_ReadRaw() always indicates EOF + * on the down channel. + */ if (dataPtr->readIsFlushed) { /* * Already flushed, nothing to do anymore. */ - return gotBytes; + break; } dataPtr->readIsFlushed = 1; @@ -705,7 +728,7 @@ TransformInputProc( * We had nothing to flush. */ - return gotBytes; + break; } continue; /* at: while (toRead > 0) */ @@ -719,9 +742,11 @@ TransformInputProc( if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read, TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) { *errorCodePtr = EINVAL; - return -1; + gotBytes = -1; + break; } } /* while toRead > 0 */ + ReleaseData(dataPtr); return gotBytes; } @@ -763,11 +788,13 @@ TransformOutputProc( return 0; } + PreserveData(dataPtr); if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite, TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) { *errorCodePtr = EINVAL; - return -1; + toWrite = -1; } + ReleaseData(dataPtr); return toWrite; } @@ -820,6 +847,7 @@ TransformSeekProc( * request down, unchanged. */ + PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE); @@ -831,6 +859,7 @@ TransformSeekProc( ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; } + ReleaseData(dataPtr); return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode, errorCodePtr); @@ -891,6 +920,7 @@ TransformWideSeekProc( * request down, unchanged. */ + PreserveData(dataPtr); if (dataPtr->mode & TCL_WRITABLE) { ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE); @@ -902,6 +932,7 @@ TransformWideSeekProc( ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; } + ReleaseData(dataPtr); /* * If we have a wide seek capability, we should stick with that. @@ -1056,6 +1087,9 @@ TransformWatchProc( * unchanged. */ + if (dataPtr->self == NULL) { + return; + } downChan = Tcl_GetStackedChannel(dataPtr->self); Tcl_GetChannelType(downChan)->watchProc( diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index cb0282a..ff602c6 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -99,31 +99,9 @@ typedef struct { Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif - - /* See [==] as well. - * Storage for the command prefix and the additional words required for - * the invocation of methods in the command handler. - * - * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] - * cmd ... pfx | method chan | detail1 detail2 - * ~~~~ CT ~~~ ~~ CT ~~ - * - * CT = Belongs to the 'Command handler Thread'. - */ - - int argc; /* Number of preallocated words - 2 */ - Tcl_Obj **argv; /* Preallocated array for calling the handler. - * args[0] is placeholder for cmd word. - * Followed by the arguments in the prefix, - * plus 4 placeholders for method, channel, - * and at most two varying (method specific) - * words. */ - int methods; /* Bitmask of supported methods */ - - /* - * NOTE (9): Should we have predefined shared literals for the method - * names? - */ + Tcl_Obj *cmd; /* Callback command prefix */ + Tcl_Obj *methods; /* Methods to append to command prefix */ + Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested @@ -450,9 +428,8 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj); static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); -static void FreeReflectedChannelArgs(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, - const char *method, Tcl_Obj *argOneObj, + MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); @@ -467,16 +444,14 @@ static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); * list-quoting to keep the words of the message together. See also [x]. */ -static const char *msg_read_unsup = "{read not supported by Tcl driver}"; static const char *msg_read_toomuch = "{read delivered more than requested}"; -static const char *msg_write_unsup = "{write not supported by Tcl driver}"; static const char *msg_write_toomuch = "{write wrote more than requested}"; static const char *msg_write_nothing = "{write wrote nothing}"; static const char *msg_seek_beforestart = "{Tried to seek before origin}"; #ifdef TCL_THREADS static const char *msg_send_originlost = "{Channel thread lost}"; -static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ +static const char *msg_send_dstlost = "{Owner lost}"; static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; /* @@ -583,10 +558,6 @@ TclChanCreateObjCmd( rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); - chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, - mode); - rcPtr->chan = chan; - chanPtr = (Channel *) chan; /* * Invoke 'initialize' and validate that the handler is present and ok. @@ -600,7 +571,7 @@ TclChanCreateObjCmd( modeObj = DecodeEventMask(mode); /* assert modeObj.refCount == 1 */ - result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj); + result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); if (result != TCL_OK) { @@ -683,7 +654,11 @@ TclChanCreateObjCmd( * Everything is fine now. */ - rcPtr->methods = methods; + chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, + mode); + rcPtr->chan = chan; + Tcl_Preserve(chan); + chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* @@ -744,12 +719,10 @@ TclChanCreateObjCmd( return TCL_OK; error: - /* - * Signal to ReflectClose to not call 'finalize'. - */ - - rcPtr->methods = 0; - Tcl_Close(interp, chan); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); + ckfree((char*) rcPtr); return TCL_ERROR; #undef MODE @@ -1138,6 +1111,7 @@ ReflectClose( ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp */ Tcl_HashEntry *hPtr; /* Entry in the above map */ + const Tcl_ChannelType *tctPtr; if (TclInThreadExit()) { /* @@ -1172,21 +1146,15 @@ ReflectClose( if (result != TCL_OK) { FreeReceivedError(&p); } + return EOK; } #endif - Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); - return EOK; - } - - /* - * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL) - * - * A cleaned method mask here implies that the channel creation was - * aborted, and "finalize" must not be called. - */ - - if (rcPtr->methods == 0) { + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } @@ -1208,14 +1176,12 @@ ReflectClose( Tcl_DeleteEvents(ReflectEventDelete, rcPtr); - Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); - if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { #endif - result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj); + result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } @@ -1253,6 +1219,11 @@ ReflectClose( } #endif + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); #ifdef TCL_THREADS } @@ -1290,18 +1261,6 @@ ReflectInput( Tcl_Obj *resObj; /* Result data for 'read' */ /* - * The following check can be done before thread redirection, because we - * are reading from an item which is readonly, i.e. will never change - * during the lifetime of the channel. - */ - - if (!(rcPtr->methods & FLAG(METH_READ))) { - SetChannelErrorStr(rcPtr->chan, msg_read_unsup); - *errorCodePtr = EINVAL; - return -1; - } - - /* * Are we in the correct thread? */ @@ -1339,7 +1298,7 @@ ReflectInput( toReadObj = Tcl_NewIntObj(toRead); Tcl_IncrRefCount(toReadObj); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -1405,18 +1364,6 @@ ReflectOutput( int written; /* - * The following check can be done before thread redirection, because we - * are reading from an item which is readonly, i.e. will never change - * during the lifetime of the channel. - */ - - if (!(rcPtr->methods & FLAG(METH_WRITE))) { - SetChannelErrorStr(rcPtr->chan, msg_write_unsup); - *errorCodePtr = EINVAL; - return -1; - } - - /* * Are we in the correct thread? */ @@ -1450,11 +1397,12 @@ ReflectOutput( /* ASSERT: rcPtr->mode & TCL_WRITABLE */ Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr->interp); bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); Tcl_IncrRefCount(bufObj); - if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -1466,6 +1414,14 @@ ReflectOutput( goto invalid; } + if (Tcl_InterpDeleted(rcPtr->interp)) { + /* + * The interp was destroyed during InvokeTclMethod(). + */ + + SetChannelErrorStr(rcPtr->chan, msg_send_dstlost); + goto invalid; + } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; @@ -1495,6 +1451,7 @@ ReflectOutput( stop: Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr->interp); Tcl_Release(rcPtr); return written; invalid: @@ -1568,7 +1525,7 @@ ReflectSeekWide( Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } @@ -1639,8 +1596,6 @@ ReflectWatch( ReflectedChannel *rcPtr = clientData; Tcl_Obj *maskObj; - /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */ - /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. @@ -1683,7 +1638,7 @@ ReflectWatch( maskObj = DecodeEventMask(mask); /* assert maskObj.refCount == 1 */ - (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL); + (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); @@ -1742,7 +1697,7 @@ ReflectBlock( Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -1854,7 +1809,7 @@ ReflectSetOption( Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); - result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj); + result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } @@ -1899,7 +1854,7 @@ ReflectGetOption( Tcl_Obj *resObj; /* Result data for 'configure' */ int listc, result = TCL_OK; Tcl_Obj **listv; - const char *method; + MethodName method; /* * Are we in the correct thread? @@ -1938,14 +1893,14 @@ ReflectGetOption( * Retrieve all options. */ - method = "cgetall"; + method = METH_CGETALL; optionObj = NULL; } else { /* * Retrieve the value of one option. */ - method = "cget"; + method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); Tcl_IncrRefCount(optionObj); } @@ -2159,16 +2114,13 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int i, listc; - Tcl_Obj **listv; + MethodName mn = METH_BLOCKING; rcPtr = ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ - /* rcPtr->methods: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; - rcPtr->methods = 0; rcPtr->interp = interp; rcPtr->dead = 0; #ifdef TCL_THREADS @@ -2177,54 +2129,17 @@ NewReflectedChannel( rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ - /* - * Method placeholder. - */ - /* ASSERT: cmdpfxObj is a Tcl List */ - - Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv); - - /* - * See [==] as well. - * Storage for the command prefix and the additional words required for - * the invocation of methods in the command handler. - * - * listv [0] [listc-1] | [listc] [listc+1] | - * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] - * cmd ... pfx | method chan | detail1 detail2 - */ - - rcPtr->argc = listc + 2; - rcPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4)); - - /* - * Duplicate object references. - */ - - for (i=0; i<listc ; i++) { - Tcl_Obj *word = rcPtr->argv[i] = listv[i]; - - Tcl_IncrRefCount(word); - } - - i++; /* Skip placeholder for method */ - - /* - * [Bug 1667990]: See [x] in FreeReflectedChannel for release - */ - - rcPtr->argv[i] = handleObj; - Tcl_IncrRefCount(handleObj); - - /* - * The next two objects are kept empty, varying arguments. - */ - - /* - * Initialization complete. - */ - + rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); + Tcl_IncrRefCount(rcPtr->cmd); + rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); + while (mn <= METH_WRITE) { + Tcl_ListObjAppendElement(NULL, rcPtr->methods, + Tcl_NewStringObj(methodNames[mn++], -1)); + } + Tcl_IncrRefCount(rcPtr->methods); + rcPtr->name = handleObj; + Tcl_IncrRefCount(rcPtr->name); return rcPtr; } @@ -2271,45 +2186,15 @@ NextHandle(void) } static void -FreeReflectedChannelArgs( - ReflectedChannel *rcPtr) -{ - int i, n = rcPtr->argc - 2; - - if (n < 0) { - return; - } - for (i=0; i<n; i++) { - Tcl_DecrRefCount(rcPtr->argv[i]); - } - - /* - * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1. - */ - - Tcl_DecrRefCount(rcPtr->argv[n+1]); - - rcPtr->argc = 1; -} - -static void FreeReflectedChannel( ReflectedChannel *rcPtr) { Channel *chanPtr = (Channel *) rcPtr->chan; - if (chanPtr->typePtr != &tclRChannelType) { - /* - * Delete a cloned ChannelType structure. - */ - - ckfree(chanPtr->typePtr); - chanPtr->typePtr = NULL; - } - - FreeReflectedChannelArgs(rcPtr); - - ckfree(rcPtr->argv); + Tcl_Release(chanPtr); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); ckfree(rcPtr); } @@ -2340,16 +2225,16 @@ FreeReflectedChannel( static int InvokeTclMethod( ReflectedChannel *rcPtr, - const char *method, + MethodName method, Tcl_Obj *argOneObj, /* NULL'able */ Tcl_Obj *argTwoObj, /* NULL'able */ Tcl_Obj **resultObjPtr) /* NULL'able */ { - int cmdc; /* #words in constructed command */ Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ int result; /* Result code of method invokation */ Tcl_Obj *resObj = NULL; /* Result of method invokation. */ + Tcl_Obj *cmd; if (rcPtr->dead) { /* @@ -2372,19 +2257,15 @@ InvokeTclMethod( } /* - * NOTE (5): Decide impl. issue: Cache objects with method names? Needs - * TSD data as reflections can be created in many different threads. - * NO: Caching of command resolutions means storage per channel. - */ - - /* - * Insert method into the pre-allocated area, after the command prefix, + * Insert method into the callback command, after the command prefix, * before the channel id. */ - methObj = Tcl_NewStringObj(method, -1); - Tcl_IncrRefCount(methObj); - rcPtr->argv[rcPtr->argc - 2] = methObj; + cmd = TclListObjCopy(NULL, rcPtr->cmd); + + Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); + Tcl_ListObjAppendElement(NULL, cmd, methObj); + Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); /* * Append the additional argument containing method specific details @@ -2394,13 +2275,10 @@ InvokeTclMethod( * The objects will survive the Tcl_EvalObjv without change. */ - cmdc = rcPtr->argc; if (argOneObj) { - rcPtr->argv[cmdc] = argOneObj; - cmdc++; + Tcl_ListObjAppendElement(NULL, cmd, argOneObj); if (argTwoObj) { - rcPtr->argv[cmdc] = argTwoObj; - cmdc++; + Tcl_ListObjAppendElement(NULL, cmd, argTwoObj); } } @@ -2409,9 +2287,10 @@ InvokeTclMethod( * existing state intact. */ + Tcl_IncrRefCount(cmd); sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); Tcl_Preserve(rcPtr->interp); - result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL); + result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL); /* * We do not try to extract the result information if the caller has no @@ -2437,7 +2316,6 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv); int cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); @@ -2451,25 +2329,17 @@ InvokeTclMethod( result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( - "\n (chan handler subcommand \"%s\")", method)); + "\n (chan handler subcommand \"%s\")", + methodNames[method])); resObj = MarshallError(rcPtr->interp); } Tcl_IncrRefCount(resObj); } + Tcl_DecrRefCount(cmd); Tcl_RestoreInterpState(rcPtr->interp, sr); Tcl_Release(rcPtr->interp); /* - * Cleanup of the dynamic parts of the command. - * - * The detail objects survived the Tcl_EvalObjv without change because of - * the contract. Therefore there is no need to decrement the refcounts. Only - * the internal method object has to be disposed of. - */ - - Tcl_DecrRefCount(methObj); - - /* * The resObj has a ref count of 1 at this location. This means that the * caller of InvokeTclMethod has to dispose of it (but only if it was * returned to it). @@ -2657,6 +2527,11 @@ DeleteReflectedChannelMap( /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; @@ -2666,6 +2541,9 @@ DeleteReflectedChannelMap( continue; } paramPtr = evPtr->param; + if (!evPtr) { + continue; + } evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; @@ -2700,7 +2578,6 @@ DeleteReflectedChannelMap( } rcPtr->dead = 1; - FreeReflectedChannelArgs(rcPtr); Tcl_DeleteHashEntry(hPtr); } #endif @@ -2797,6 +2674,11 @@ DeleteThreadReflectedChannelMap( /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; @@ -2806,6 +2688,9 @@ DeleteThreadReflectedChannelMap( continue; } paramPtr = evPtr->param; + if (!evPtr) { + continue; + } evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; @@ -2840,7 +2725,6 @@ DeleteThreadReflectedChannelMap( ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan); rcPtr->dead = 1; - FreeReflectedChannelArgs(rcPtr); Tcl_DeleteHashEntry(hPtr); } ckfree(rcmPtr); @@ -3018,17 +2902,19 @@ ForwardProc( * call upon for the driver. */ - case ForwardedClose: + case ForwardedClose: { /* * No parameters/results. */ - if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) { + const Tcl_ChannelType *tctPtr; + + if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* - * Freeing is done here, in the origin thread, because the argv[] + * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different * thread is not allowed * @@ -3047,15 +2933,21 @@ ForwardProc( Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); - FreeReflectedChannelArgs(rcPtr); + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } + Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); break; + } case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -3095,7 +2987,7 @@ ForwardProc( Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -3138,7 +3030,7 @@ ForwardProc( Tcl_IncrRefCount(baseObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } else { @@ -3174,7 +3066,7 @@ ForwardProc( /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); - (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL); + (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); break; @@ -3185,7 +3077,7 @@ ForwardProc( Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } @@ -3201,7 +3093,7 @@ ForwardProc( Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, + if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } @@ -3220,7 +3112,7 @@ ForwardProc( Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); @@ -3236,7 +3128,7 @@ ForwardProc( */ Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1de635f..d2707a1 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -457,8 +457,7 @@ static void TimerKill(ReflectedTransform *rtPtr); static void TimerSetup(ReflectedTransform *rtPtr); static void TimerRun(ClientData clientData); static int TransformRead(ReflectedTransform *rtPtr, - int *errorCodePtr, unsigned char *buf, - int toRead); + int *errorCodePtr, Tcl_Obj *bufObj); static int TransformWrite(ReflectedTransform *rtPtr, int *errorCodePtr, unsigned char *buf, int toWrite); @@ -1063,6 +1062,7 @@ ReflectInput( { ReflectedTransform *rtPtr = clientData; int gotBytes, copied, readBytes; + Tcl_Obj *bufObj; /* * The following check can be done before thread redirection, because we @@ -1078,6 +1078,9 @@ ReflectInput( Tcl_Preserve(rtPtr); + /* TODO: Consider a more appropriate buffer size. */ + bufObj = Tcl_NewByteArrayObj(NULL, toRead); + Tcl_IncrRefCount(bufObj); gotBytes = 0; while (toRead > 0) { /* @@ -1129,52 +1132,40 @@ ReflectInput( goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead); + + readBytes = Tcl_ReadRaw(rtPtr->parent, + (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { - /* - * Report errors to caller. The state of the seek system is - * unchanged! - */ + if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) { - 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. + * Down channel is blocked and offers zero additional bytes. + * The nonzero gotBytes already returned makes the total + * operation a valid short read. Return to caller. */ goto stop; } + /* + * Either the down channel is not blocked (a real error) + * or it is and there are gotBytes==0 byte copied so far. + * In either case, pass up the error, so we either report + * any real error, or do not mistakenly signal EOF by + * returning 0 to the caller. + */ + *errorCodePtr = Tcl_GetErrno(); goto error; } if (readBytes == 0) { + /* - * 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. + * Zero returned from Tcl_ReadRaw() always indicates EOF + * on the down channel. */ - - if (!Tcl_Eof(rtPtr->parent)) { - /* - * The state of the seek system is unchanged! - */ - - if ((gotBytes == 0) && rtPtr->nonblocking) { - *errorCodePtr = EWOULDBLOCK; - goto error; - } - goto stop; - } else { - /* - * Eof in parent. - */ - + if (rtPtr->readIsDrained) { goto stop; } @@ -1198,13 +1189,7 @@ ReflectInput( goto stop; } - /* - * Reset eof, force caller to drain result buffer. - */ - - ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF; continue; /* at: while (toRead > 0) */ - } } /* readBytes == 0 */ /* @@ -1213,12 +1198,20 @@ ReflectInput( * iteration will put it into the result. */ - if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) { + Tcl_SetByteArrayLength(bufObj, readBytes); + if (!TransformRead(rtPtr, errorCodePtr, bufObj)) { goto error; } + if (Tcl_IsShared(bufObj)) { + Tcl_DecrRefCount(bufObj); + bufObj = Tcl_NewObj(); + Tcl_IncrRefCount(bufObj); + } + Tcl_SetByteArrayLength(bufObj, 0); } /* while toRead > 0 */ stop: + Tcl_DecrRefCount(bufObj); Tcl_Release(rtPtr); return gotBytes; @@ -2010,6 +2003,7 @@ InvokeTclMethod( sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */); Tcl_Preserve(rtPtr); + Tcl_Preserve(rtPtr->interp); result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL); /* @@ -2054,6 +2048,7 @@ InvokeTclMethod( Tcl_IncrRefCount(resObj); } Tcl_RestoreInterpState(rtPtr->interp, sr); + Tcl_Release(rtPtr->interp); Tcl_Release(rtPtr); /* @@ -2230,6 +2225,9 @@ DeleteReflectedTransformMap( */ evPtr = resultPtr->evPtr; + if (evPtr == NULL) { + continue; + } paramPtr = evPtr->param; evPtr->resultPtr = NULL; @@ -2355,6 +2353,9 @@ DeleteThreadReflectedTransformMap( */ evPtr = resultPtr->evPtr; + if (evPtr == NULL) { + continue; + } paramPtr = evPtr->param; evPtr->resultPtr = NULL; @@ -3065,10 +3066,8 @@ static int TransformRead( ReflectedTransform *rtPtr, int *errorCodePtr, - unsigned char *buf, - int toRead) + Tcl_Obj *bufObj) { - Tcl_Obj *bufObj; Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -3081,8 +3080,8 @@ TransformRead( if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - p.transform.buf = (char *) buf; - p.transform.size = toRead; + p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, + &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); @@ -3102,12 +3101,8 @@ TransformRead( /* ASSERT: rtPtr->method & FLAG(METH_READ) */ /* ASSERT: rtPtr->mode & TCL_READABLE */ - bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead); - Tcl_IncrRefCount(bufObj); - if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); - Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; @@ -3116,7 +3111,6 @@ TransformRead( bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); - Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 6259216..d2919fc 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -19,11 +19,17 @@ */ #include "tclInt.h" -#ifdef __WIN32__ +#ifdef _WIN32 # include "tclWinInt.h" #endif #include "tclFileSystem.h" +#ifdef TCL_TEMPLOAD_NO_UNLINK +#ifndef NO_FSTATFS +#include <sys/statfs.h> +#endif +#endif + /* * struct FilesystemRecord -- * @@ -792,7 +798,7 @@ TclFinalizeFilesystem(void) * filesystem is likely to fail. */ -#ifdef __WIN32__ +#ifdef _WIN32 TclWinEncodingsCleanup(); #endif } @@ -819,7 +825,7 @@ TclResetFilesystem(void) filesystemList = &nativeFilesystemRecord; theFilesystemEpoch++; -#ifdef __WIN32__ +#ifdef _WIN32 /* * Cleans up the win32 API filesystem proc lookup table. This must happen * very late in finalization so that deleting of copied dlls can occur. @@ -3110,6 +3116,82 @@ Tcl_FSLoadFile( *---------------------------------------------------------------------- */ +/* + * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY + * error) yet somehow trash some internal data structures which prevents the + * second and further shared libraries from getting properly loaded. Only the + * first is ok. We try to get around the issue by not unlinking, + * i.e. emulating the behaviour of the older HPUX which denied removal. + * + * Doing the unlink is also an issue within docker containers, whose AUFS + * bungles this as well, see + * https://github.com/dotcloud/docker/issues/1911 + * + * For these situations the change below makes the execution of the unlink + * semi-controllable at runtime. + * + * An AUFS filesystem (if it can be detected) will force avoidance of + * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a + * users general request (unlink and not. + * + * By default the unlink is done (if not in AUFS). However if the variable is + * present and set to true (any integer > 0) then the unlink is skipped. + */ + +int +TclSkipUnlink (Tcl_Obj* shlibFile) +{ + /* Order of testing: + * 1. On hpux we generally want to skip unlink in general + * + * Outside of hpux then: + * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int) + * 3. For general AUFS environment (statfs, if available). + * + * Ad 2: This variable can disable/override the AUFS detection, i.e. for + * testing if a newer AUFS does not have the bug any more. + * + * Ad 3: This is conditionally compiled in. Condition currently must be set manually. + * This part needs proper tests in the configure(.in). + */ + +#ifdef hpux + return 1; +#else + char* skipstr; + + skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK"); + if (skipstr && (skipstr[0] != '\0')) { + return atoi(skipstr); + } + +#ifdef TCL_TEMPLOAD_NO_UNLINK +#ifndef NO_FSTATFS + { + struct statfs fs; + /* Have fstatfs. May not have the AUFS super magic ... Indeed our build + * box is too old to have it directly in the headers. Define taken from + * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h + * http://aufs.sourceforge.net/ + * Better reference will be gladly taken. + */ +#ifndef AUFS_SUPER_MAGIC +#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's') +#endif /* AUFS_SUPER_MAGIC */ + if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) && + (fs.f_type == AUFS_SUPER_MAGIC)) { + return 1; + } + } +#endif /* ... NO_FSTATFS */ +#endif /* ... TCL_TEMPLOAD_NO_UNLINK */ + + /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected): + * Don't skip */ + return 0; +#endif /* hpux */ +} + int Tcl_LoadFile( Tcl_Interp *interp, /* Used for error reporting. */ @@ -3255,7 +3337,7 @@ Tcl_LoadFile( return TCL_ERROR; } -#ifndef __WIN32__ +#ifndef _WIN32 /* * Do we need to set appropriate permissions on the file? This may be * required on some systems. On Unix we could loop over the file @@ -3300,7 +3382,9 @@ Tcl_LoadFile( * avoids any worries about leaving the copy laying around on exit. */ - if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) { + if ( + !TclSkipUnlink (copyToPtr) && + (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { Tcl_DecrRefCount(copyToPtr); /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 2aa1725..9a2e8dd 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2453,6 +2453,30 @@ typedef struct List { #endif /* + * Macro used to save a function call for common uses of + * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: + * + * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + * Tcl_WideInt *wideIntPtr); + */ + +#ifdef TCL_WIDE_INT_IS_LONG +#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? (*(wideIntPtr) = (Tcl_WideInt) \ + ((objPtr)->internalRep.longValue), TCL_OK) : \ + Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) +#else /* !TCL_WIDE_INT_IS_LONG */ +#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ + (((objPtr)->typePtr == &tclWideIntType) \ + ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ + ((objPtr)->typePtr == &tclIntType) \ + ? (*(wideIntPtr) = (Tcl_WideInt) \ + ((objPtr)->internalRep.longValue), TCL_OK) : \ + Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) +#endif /* TCL_WIDE_INT_IS_LONG */ + +/* * Flag values for TclTraceDictPath(). * * DICT_PATH_READ indicates that all entries on the path must exist but no @@ -2857,6 +2881,10 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, MODULE_SCOPE int TclConvertElement(const char *src, int length, char *dst, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); +MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, + const char *dict, int dictLength, + const char **elementPtr, const char **nextPtr, + int *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line, @@ -2896,6 +2924,7 @@ MODULE_SCOPE void TclFinalizeObjects(void); MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); +MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(void); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const mp_int *a); @@ -2921,6 +2950,8 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, + unsigned int *sizePtr); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 72719fe..ac06787 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -13,7 +13,7 @@ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS -#ifdef __WIN32__ +#ifdef _WIN32 # define Tcl_DirEntry void # define DIR void #endif @@ -45,7 +45,7 @@ extern "C" { * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 0 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -104,7 +104,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* UNIX */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN void TclWinConvertError(DWORD errCode); /* 1 */ @@ -258,7 +258,7 @@ typedef struct TclIntPlatStubs { int magic; void *hooks; -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#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 */ @@ -291,7 +291,7 @@ typedef struct TclIntPlatStubs { int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* 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 */ @@ -371,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */ #define TclpCloseFile \ @@ -420,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #define TclUnixOpenTemporaryFile \ (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ #define TclWinConvertWSAError \ @@ -550,9 +550,15 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclpInetNtoa #define TclpInetNtoa inet_ntoa -#if defined(__WIN32__) || defined(__CYGWIN__) +#if defined(_WIN32) # undef TclWinNToHS +# undef TclWinGetServByName +# undef TclWinGetSockOpt +# undef TclWinSetSockOpt # define TclWinNToHS ntohs +# define TclWinGetServByName getservbyname +# define TclWinGetSockOpt getsockopt +# define TclWinSetSockOpt setsockopt #else # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 5cacab1..7c70e03 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -830,7 +830,7 @@ Tcl_UnloadObjCmd( * Unload the shared library from the application memory... */ -#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) +#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32) /* * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get @@ -1151,7 +1151,7 @@ TclFinalizeLoad(void) pkgPtr = firstPackagePtr; firstPackagePtr = pkgPtr->nextPtr; -#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__) +#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32) /* * Some Unix dlls are poorly behaved - registering things like atexit * calls that can't be unregistered. If you unload such dlls, you get diff --git a/generic/tclMain.c b/generic/tclMain.c index faea75a..360f5e9 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -47,7 +47,7 @@ * we have to translate that to strcmp here. */ -#ifndef __WIN32__ +#ifndef _WIN32 # define TCHAR char # define TEXT(arg) arg # define _tcscmp strcmp diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 5d6f2c2..265ba88 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -18,6 +18,7 @@ library tclOO interface tclOO hooks tclOOInt +scspec TCLAPI declare 0 { Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index d3b9e59..9fd62ec 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -5,19 +5,19 @@ #ifndef _TCLOODECLS #define _TCLOODECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# undef USE_TCLOO_STUBS -# define USE_TCLOO_STUBS -# define TCL_STORAGE_CLASS +#ifndef TCLAPI +# ifdef BUILD_tcl +# define TCLAPI extern DLLEXPORT # else -# define TCL_STORAGE_CLASS DLLIMPORT +# define TCLAPI extern DLLIMPORT # endif #endif +#ifdef USE_TCL_STUBS +# undef USE_TCLOO_STUBS +# define USE_TCLOO_STUBS +#endif + /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus @@ -29,92 +29,92 @@ extern "C" { */ /* 0 */ -EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, +TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 1 */ -EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); +TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); /* 2 */ -EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); +TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); /* 3 */ -EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); +TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); /* 4 */ -EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, +TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 5 */ -EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); +TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); /* 6 */ -EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); +TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); /* 7 */ -EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); +TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); /* 8 */ -EXTERN int Tcl_MethodIsPublic(Tcl_Method method); +TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ -EXTERN int Tcl_MethodIsType(Tcl_Method method, +TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 10 */ -EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method); +TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ -EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, +TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ -EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, +TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 13 */ -EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, +TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 14 */ -EXTERN int Tcl_ObjectDeleted(Tcl_Object object); +TCLAPI int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ -EXTERN int Tcl_ObjectContextIsFiltering( +TCLAPI int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context); /* 16 */ -EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); +TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ -EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); +TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ -EXTERN int Tcl_ObjectContextSkippedArgs( +TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ -EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz, +TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 21 */ -EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ -EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object, +TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 23 */ -EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, +TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 24 */ -EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( +TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); /* 25 */ -EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, +TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 26 */ -EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp, +TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ -EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp, +TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 28 */ -EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object); typedef struct { @@ -231,6 +231,4 @@ extern const TclOOStubs *tclOOStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOODECLS */ diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 4f70e5b..74a8d81 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -5,17 +5,6 @@ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus @@ -27,46 +16,46 @@ extern "C" { */ /* 0 */ -EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); +TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); /* 1 */ -EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ -EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 3 */ -EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, +TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ -EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, +TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ -EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, +TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ -EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr); +TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); /* 7 */ -EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp, +TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ -EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, +TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 9 */ -EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -75,7 +64,7 @@ EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ -EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -84,22 +73,22 @@ EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ -EXTERN int TclOOInvokeObject(Tcl_Interp *interp, +TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 12 */ -EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters, +TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ -EXTERN void TclOOClassSetFilters(Tcl_Interp *interp, +TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 14 */ -EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins, +TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins, Class *const *mixins); /* 15 */ -EXTERN void TclOOClassSetMixins(Tcl_Interp *interp, +TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); @@ -174,6 +163,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOOINTDECLS */ diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index b7f3dcf..fe6063f 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -512,7 +512,7 @@ TclFSGetPathType( if (PATHFLAGS(pathPtr) == 0) { /* The path is not absolute... */ -#ifdef __WIN32__ +#ifdef _WIN32 /* ... on Windows we must make another call to determine whether * it's relative or volumerelative [Bug 2571597]. */ return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, @@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath( /* * We have a refCount on the cwd. */ -#ifdef __WIN32__ +#ifdef _WIN32 } else if (type == TCL_PATH_VOLUME_RELATIVE) { /* * Only Windows has volume-relative paths. @@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath( return NULL; } pureNormalized = 0; -#endif /* __WIN32__ */ +#endif /* _WIN32 */ } } diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index 681854d..abc8ee8 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -50,7 +50,7 @@ extern "C" { * Exported function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); @@ -75,7 +75,7 @@ typedef struct TclPlatStubs { int magic; void *hooks; -#if defined(__WIN32__) || defined(__CYGWIN__) /* 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 */ @@ -97,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index dffa38c..c04944d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1123,7 +1123,8 @@ Tcl_AppendLimitedToObj( if (ellipsis == NULL) { ellipsis = "..."; } - toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; + toCopy = (bytes == NULL) ? limit + : Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; } /* @@ -1435,7 +1436,7 @@ AppendUnicodeToUnicodeRep( * the reallocs below. */ - if (unicode >= stringPtr->unicode + if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { offset = unicode - stringPtr->unicode; } @@ -1457,8 +1458,10 @@ AppendUnicodeToUnicodeRep( * trailing null. */ - memmove(stringPtr->unicode + stringPtr->numChars, unicode, - appendNumChars * sizeof(Tcl_UniChar)); + if (unicode) { + memmove(stringPtr->unicode + stringPtr->numChars, unicode, + appendNumChars * sizeof(Tcl_UniChar)); + } stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; stringPtr->allocated = 0; @@ -1597,7 +1600,7 @@ AppendUtfToUtfRep( * the reallocs below. */ - if (bytes >= objPtr->bytes + if (bytes && bytes >= objPtr->bytes && bytes <= objPtr->bytes + objPtr->length) { offset = bytes - objPtr->bytes; } @@ -1625,7 +1628,9 @@ AppendUtfToUtfRep( stringPtr->numChars = -1; stringPtr->hasUnicode = 0; - memmove(objPtr->bytes + oldLength, bytes, numBytes); + if (bytes) { + memmove(objPtr->bytes + oldLength, bytes, numBytes); + } objPtr->bytes[newLength] = 0; objPtr->length = newLength; } @@ -2658,6 +2663,38 @@ Tcl_ObjPrintf( /* *--------------------------------------------------------------------------- * + * TclGetStringStorage -- + * + * Returns the string storage space of a Tcl_Obj. + * + * Results: + * The pointer value objPtr->bytes is returned and the number of bytes + * allocated there is written to *sizePtr (if known). + * + * Side effects: + * May set objPtr->bytes. + * + *--------------------------------------------------------------------------- + */ + +char * +TclGetStringStorage( + Tcl_Obj *objPtr, + unsigned int *sizePtr) +{ + String *stringPtr; + + if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) { + return TclGetStringFromObj(objPtr, (int *)sizePtr); + } + + stringPtr = GET_STRING(objPtr); + *sizePtr = stringPtr->allocated; + return objPtr->bytes; +} +/* + *--------------------------------------------------------------------------- + * * TclStringObjReverse -- * * Implements the [string reverse] operation. @@ -2848,7 +2885,11 @@ ExtendUnicodeRepWithString( } stringPtr->hasUnicode = 1; - stringPtr->numChars = needed; + if (bytes) { + stringPtr->numChars = needed; + } else { + numAppendChars = 0; + } for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { bytes += TclUtfToUniChar(bytes, dst); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e1918ef..7a84cba 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -44,6 +44,9 @@ #define TclBackgroundException Tcl_BackgroundException #undef Tcl_SetIntObj #undef TclpInetNtoa +#undef TclWinGetServByName +#undef TclWinGetSockOpt +#undef TclWinSetSockOpt /* See bug 510001: TclSockMinimumBuffers needs plat imp */ #ifdef _WIN64 @@ -90,7 +93,7 @@ static unsigned short TclWinNToHS(unsigned short ns) { } #endif -#ifdef __WIN32__ +#ifdef _WIN32 # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 @@ -111,7 +114,8 @@ TclpIsAtty(int fd) return isatty(fd); } -int +#define TclWinGetPlatformId winGetPlatformId +static int TclWinGetPlatformId() { /* Don't bother to determine the real platform on cygwin, @@ -127,27 +131,31 @@ void *TclWinGetTclInstance() return hInstance; } -int +#define TclWinSetSockOpt winSetSockOpt +static int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) { return setsockopt((int) s, level, optname, optval, optlen); } -int +#define TclWinGetSockOpt winGetSockOpt +static int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen) { return getsockopt((int) s, level, optname, optval, optlen); } -struct servent * +#define TclWinGetServByName winGetServByName +static struct servent * TclWinGetServByName(const char *name, const char *proto) { return getservbyname(name, proto); } -char * +#define TclWinNoBackslash winNoBackslash +static char * TclWinNoBackslash(char *path) { char *p; @@ -557,7 +565,7 @@ static const TclIntStubs tclIntStubs = { static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ TclGetAndDetachPids, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ @@ -590,7 +598,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ TclWinConvertWSAError, /* 1 */ TclWinGetServByName, /* 2 */ @@ -661,7 +669,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ #endif /* WIN */ @@ -758,19 +766,19 @@ const TclStubs tclStubs = { Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_CreateFileHandler, /* 9 */ #endif /* UNIX */ -#if defined(__WIN32__) /* WIN */ +#if defined(_WIN32) /* WIN */ 0, /* 9 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_CreateFileHandler, /* 9 */ #endif /* MACOSX */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ #endif /* UNIX */ -#if defined(__WIN32__) /* WIN */ +#if defined(_WIN32) /* WIN */ 0, /* 10 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ @@ -932,10 +940,10 @@ const TclStubs tclStubs = { Tcl_GetMaster, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ -#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ +#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_GetOpenFile, /* 167 */ #endif /* UNIX */ -#if defined(__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 f121d0d..a27c95a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -414,7 +414,7 @@ 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__) +#if defined(HAVE_CPUID) || defined(_WIN32) static int TestcpuidCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); @@ -681,7 +681,7 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); -#if defined(HAVE_CPUID) || defined(__WIN32__) +#if defined(HAVE_CPUID) || defined(_WIN32) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif @@ -6648,7 +6648,7 @@ TestNumUtfCharsCmd( return TCL_OK; } -#if defined(HAVE_CPUID) || defined(__WIN32__) +#if defined(HAVE_CPUID) || defined(_WIN32) /* *---------------------------------------------------------------------- * diff --git a/generic/tclThread.c b/generic/tclThread.c index d1f2691..8c972a8 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -339,8 +339,9 @@ Tcl_ConditionFinalize( * * TclFinalizeThreadData -- * - * This function cleans up the thread-local storage. This is called once - * for each thread. + * This function cleans up the thread-local storage. Secondary, it cleans + * thread alloc cache. + * This is called once for each thread before thread exits. * * Results: * None. @@ -355,6 +356,9 @@ void TclFinalizeThreadData(void) { TclFinalizeThreadDataThread(); +#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) + TclFinalizeThreadAllocThread(); +#endif } /* diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index abd5af5..ddf888a 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -1023,6 +1023,33 @@ TclFinalizeThreadAlloc(void) TclpFreeAllocCache(NULL); } +/* + *---------------------------------------------------------------------- + * + * TclFinalizeThreadAllocThread -- + * + * This procedure is used to destroy single thread private resources used + * in this file. + * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread). + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclFinalizeThreadAllocThread(void) +{ + Cache *cachePtr = TclpGetAllocCache(); + if (cachePtr != NULL) { + TclpFreeAllocCache(cachePtr); + } +} + #else /* !(TCL_THREADS && USE_THREAD_ALLOC) */ /* *---------------------------------------------------------------------- diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c index 4b09e1c..5c70a62 100644 --- a/generic/tclThreadJoin.c +++ b/generic/tclThreadJoin.c @@ -14,7 +14,7 @@ #include "tclInt.h" -#ifdef WIN32 +#ifdef _WIN32 /* * The information about each joinable thread is remembered in a structure as @@ -305,7 +305,7 @@ TclSignalExitThread( Tcl_MutexUnlock(&threadPtr->threadMutex); } -#endif /* WIN32 */ +#endif /* _WIN32 */ /* * Local Variables: diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 2d00adf..ae3adae 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -111,7 +111,11 @@ static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int SetEndOffsetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfEndOffset(Tcl_Obj *objPtr); - +static int FindElement(Tcl_Interp *interp, const char *string, + int stringLength, const char *typeStr, + const char *typeCode, const char **elementPtr, + const char **nextPtr, int *sizePtr, + int *literalPtr); /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a @@ -237,7 +241,7 @@ const Tcl_ObjType tclEndOffsetType = { * of either braces or quotes to delimit it. * * This collection of parsing rules is implemented in the routine - * TclFindElement(). + * FindElement(). * * In order to produce lists that can be parsed by these rules, we need the * ability to distinguish between characters that are part of a list element @@ -505,9 +509,70 @@ TclFindElement( * does not/does require a call to * TclCopyAndCollapse() by the caller. */ { - const char *p = list; + return FindElement(interp, list, listLength, "list", "LIST", elementPtr, + nextPtr, sizePtr, literalPtr); +} + +int +TclFindDictElement( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If + * NULL, then no error message is left after + * errors. */ + const char *dict, /* Points to the first byte of a string + * containing a Tcl dictionary with zero or + * more keys and values (possibly in + * braces). */ + int dictLength, /* Number of bytes in the dict's string. */ + const char **elementPtr, /* Where to put address of first significant + * character in the first element (i.e., key + * or value) of dict. */ + const char **nextPtr, /* Fill in with location of character just + * after all white space following end of + * element (next arg or end of list). */ + int *sizePtr, /* If non-zero, fill in with size of + * element. */ + int *literalPtr) /* If non-zero, fill in with non-zero/zero to + * indicate that the substring of *sizePtr + * bytes starting at **elementPtr is/is not + * the literal key or value and therefore + * does not/does require a call to + * TclCopyAndCollapse() by the caller. */ +{ + return FindElement(interp, dict, dictLength, "dict", "DICTIONARY", + elementPtr, nextPtr, sizePtr, literalPtr); +} + +static int +FindElement( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If + * NULL, then no error message is left after + * errors. */ + const char *string, /* Points to the first byte of a string + * containing a Tcl list or dictionary with + * zero or more elements (possibly in + * braces). */ + int stringLength, /* Number of bytes in the string. */ + const char *typeStr, /* The name of the type of thing we are + * parsing, for error messages. */ + const char *typeCode, /* The type code for thing we are parsing, for + * error messages. */ + const char **elementPtr, /* Where to put address of first significant + * character in first element. */ + const char **nextPtr, /* Fill in with location of character just + * after all white space following end of + * argument (next arg or end of list/dict). */ + int *sizePtr, /* If non-zero, fill in with size of + * element. */ + int *literalPtr) /* If non-zero, fill in with non-zero/zero to + * indicate that the substring of *sizePtr + * bytes starting at **elementPtr is/is not + * the literal list/dict element and therefore + * does not/does require a call to + * TclCopyAndCollapse() by the caller. */ +{ + const char *p = string; const char *elemStart; /* Points to first byte of first element. */ - const char *limit; /* Points just after list's last byte. */ + const char *limit; /* Points just after list/dict's last byte. */ int openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; int size = 0; /* lint. */ @@ -517,11 +582,11 @@ TclFindElement( /* * Skim off leading white space and check for an opening brace or quote. - * We treat embedded NULLs in the list as bytes belonging to a list - * element. + * We treat embedded NULLs in the list/dict as bytes belonging to a list + * element (or dictionary key or value). */ - limit = (list + listLength); + limit = (string + stringLength); while ((p < limit) && (TclIsSpaceProc(*p))) { p++; } @@ -582,9 +647,9 @@ TclFindElement( p2++; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "list element in braces followed by \"%.*s\" " - "instead of space", (int) (p2-p), p)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK", + "%s element in braces followed by \"%.*s\" " + "instead of space", typeStr, (int) (p2-p), p)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK", NULL); } return TCL_ERROR; @@ -651,9 +716,9 @@ TclFindElement( p2++; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "list element in quotes followed by \"%.*s\" " - "instead of space", (int) (p2-p), p)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK", + "%s element in quotes followed by \"%.*s\" " + "instead of space", typeStr, (int) (p2-p), p)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK", NULL); } return TCL_ERROR; @@ -664,23 +729,23 @@ TclFindElement( } /* - * End of list: terminate element. + * End of list/dict: terminate element. */ if (p == limit) { if (openBraces != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched open brace in list", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unmatched open brace in %s", typeStr)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE", NULL); } return TCL_ERROR; } else if (inQuotes) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched open quote in list", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unmatched open quote in %s", typeStr)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE", NULL); } return TCL_ERROR; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 9bceb4c..2e27303 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -2994,47 +2994,18 @@ ZlibTransformInput( */ 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. - */ + /* See ReflectInput() in tclIORTrans.c */ + if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { return gotBytes; } *errorCodePtr = Tcl_GetErrno(); return -1; - } else if (readBytes == 0) { - /* - * 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; - } - + } + if (readBytes == 0) { /* - * (Semi-)Eof in parent. + * Eof in parent. * * Now this is a bit different. The partial data waiting is * converted and returned. @@ -3052,12 +3023,6 @@ ZlibTransformInput( 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 |