From 46a826db38fe47acda1efb7714281b9df8ead242 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 25 Apr 2012 12:07:45 +0000 Subject: * generic/tclUtil.c (TclDStringToObj): Added internal function to make the fairly-common operation of converting a DString into an Obj a more efficient one. --- ChangeLog | 11 ++++++++++ generic/tclCmdAH.c | 12 +++-------- generic/tclFileName.c | 13 ++++-------- generic/tclInt.h | 1 + generic/tclMain.c | 23 +++++++++++--------- generic/tclPathObj.c | 5 +---- generic/tclRegexp.c | 4 +--- generic/tclUtil.c | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclZlib.c | 8 ++----- unix/tclUnixFCmd.c | 6 ++---- unix/tclUnixFile.c | 22 ++++--------------- unix/tclUnixInit.c | 7 ++----- win/tclWinFCmd.c | 12 +++++------ win/tclWinFile.c | 6 +----- win/tclWinInit.c | 5 ++--- 15 files changed, 110 insertions(+), 83 deletions(-) diff --git a/ChangeLog b/ChangeLog index 17daabc..bf2201b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2012-04-25 Donal K. Fellows + + * generic/tclUtil.c (TclDStringToObj): Added internal function to make + the fairly-common operation of converting a DString into an Obj a more + efficient one; for long strings, it can just transfer the ownership of + the buffer directly. Replaces this: + obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + with this: + obj=TclDStringToObj(&ds); + 2012-04-24 Jan Nijtmans * generic/tclInt.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 1cbc4d2..70aef8d 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -563,9 +563,7 @@ Tcl_EncodingObjCmd( * truncate the string at the first null byte. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, TclDStringToObj(&ds)); } else { /* * Store the result as binary data. @@ -1869,20 +1867,16 @@ PathNativeNameCmd( int objc, Tcl_Obj *const objv[]) { - const char *fileName; Tcl_DString ds; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - fileName = Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds); - if (fileName == NULL) { + if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(fileName, - Tcl_DStringLength(&ds))); - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, TclDStringToObj(&ds)); return TCL_OK; } diff --git a/generic/tclFileName.c b/generic/tclFileName.c index b6b89dd..5048308 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -445,8 +445,7 @@ TclpGetNativePathType( if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { *driveNameLengthPtr = rootEnd - path; if (driveNameRef != NULL) { - *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); + *driveNameRef = TclDStringToObj(&ds); Tcl_IncrRefCount(*driveNameRef); } } @@ -724,8 +723,7 @@ SplitWinPath( */ if (p != path) { - Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj( - Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); + Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf)); } Tcl_DStringFree(&buf); @@ -1751,14 +1749,12 @@ TclGlob( if (head != Tcl_DStringValue(&buffer)) { Tcl_DStringAppend(&buffer, head, -1); } - pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer), - Tcl_DStringLength(&buffer)); + pathPrefix = TclDStringToObj(&buffer); Tcl_IncrRefCount(pathPrefix); globFlags |= TCL_GLOBMODE_DIR; if (c != '\0') { tail++; } - Tcl_DStringFree(&buffer); } else { tail = pattern; } @@ -2423,8 +2419,7 @@ DoGlob( */ if (pathPtr == NULL) { - joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append), - Tcl_DStringLength(&append)); + joinedPtr = TclDStringToObj(&append); } else if (flags) { joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append), Tcl_DStringLength(&append)); diff --git a/generic/tclInt.h b/generic/tclInt.h index 08b3f70..9068dfb 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2920,6 +2920,7 @@ MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, ClientData clientData); +MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); diff --git a/generic/tclMain.c b/generic/tclMain.c index 373e3f6..88b4e51 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -53,20 +53,23 @@ #endif /* - * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj, - * while otherwise NewNativeObj is needed (which provides proper - * conversion from native encoding to UTF-8). + * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise + * NewNativeObj is needed (which provides proper conversion from native + * encoding to UTF-8). */ + #ifdef UNICODE # define NewNativeObj Tcl_NewUnicodeObj #else /* !UNICODE */ - static Tcl_Obj *NewNativeObj(char *string, int length) { - Tcl_Obj *obj; - Tcl_DString ds; - Tcl_ExternalToUtfDString(NULL, string, length, &ds); - obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - return obj; +static inline Tcl_Obj * +NewNativeObj( + char *string, + int length) +{ + Tcl_DString ds; + + Tcl_ExternalToUtfDString(NULL, string, length, &ds); + return TclDStringToObj(&ds); } #endif /* !UNICODE */ diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index ba07808..4f86755 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2373,7 +2373,6 @@ SetFsPathFromAny( */ if (name[0] == '~') { - char *expandedUser; Tcl_DString temp; int split; char separator = '/'; @@ -2442,8 +2441,7 @@ SetFsPathFromAny( } } - expandedUser = Tcl_DStringValue(&temp); - transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); + transPtr = TclDStringToObj(&temp); if (split != len) { /* @@ -2488,7 +2486,6 @@ SetFsPathFromAny( transPtr = joined; } } - Tcl_DStringFree(&temp); } else { transPtr = TclJoinPath(1, &pathPtr); } diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 5c5af7b..53d7153 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -947,10 +947,8 @@ CompileRegexp( */ if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) { - regexpPtr->globObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&stringBuf), - Tcl_DStringLength(&stringBuf)); + regexpPtr->globObjPtr = TclDStringToObj(&stringBuf); Tcl_IncrRefCount(regexpPtr->globObjPtr); - Tcl_DStringFree(&stringBuf); } else { regexpPtr->globObjPtr = NULL; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index a1c1996..d5a3b94 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2715,6 +2715,64 @@ Tcl_DStringGetResult( /* *---------------------------------------------------------------------- * + * TclDStringToObj -- + * + * This function moves a dynamic string's contents to a new Tcl_Obj. Be + * aware that this function does *not* check that the encoding of the + * contents of the dynamic string is correct; this is the caller's + * responsibility to enforce. + * + * Results: + * The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a + * reference count of zero. + * + * Side effects: + * The string is "moved" to the object. dsPtr is reinitialized to an + * empty string; it does not need to be Tcl_DStringFree'd after this if + * not used further. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclDStringToObj( + Tcl_DString *dsPtr) +{ + Tcl_Obj *result; + + if (dsPtr->length == 0) { + TclNewObj(result); + } else if (dsPtr->string == dsPtr->staticSpace) { + /* + * Static buffer, so must copy. + */ + + TclNewStringObj(result, dsPtr->string, dsPtr->length); + } else { + /* + * Dynamic buffer, so transfer ownership and reset. + */ + + TclNewObj(result); + result->bytes = dsPtr->string; + result->length = dsPtr->length; + } + + /* + * Re-establish the DString as empty with no buffer allocated. + */ + + dsPtr->string = dsPtr->staticSpace; + dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; + dsPtr->length = 0; + dsPtr->staticSpace[0] = '\0'; + + return result; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DStringStartSublist -- * * This function adds the necessary information to a dynamic string diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 341f8e0..3673833 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -399,9 +399,7 @@ ExtractHeader( Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1, &tmp); - SetValue(dictObj, "comment", Tcl_NewStringObj(Tcl_DStringValue(&tmp), - Tcl_DStringLength(&tmp))); - Tcl_DStringFree(&tmp); + SetValue(dictObj, "comment", TclDStringToObj(&tmp)); } SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); if (headerPtr->name != Z_NULL) { @@ -418,9 +416,7 @@ ExtractHeader( Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1, &tmp); - SetValue(dictObj, "filename", Tcl_NewStringObj(Tcl_DStringValue(&tmp), - Tcl_DStringLength(&tmp))); - Tcl_DStringFree(&tmp); + SetValue(dictObj, "filename", TclDStringToObj(&tmp)); } if (headerPtr->os != 255) { SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os)); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index e3d9022..fce071f 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1387,11 +1387,9 @@ GetOwnerAttribute( *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); } else { Tcl_DString ds; - const char *utf; - utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); - *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); + *attributePtrPtr = TclDStringToObj(&ds); } return TCL_OK; } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 05c8058..0b8aaf9 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -1002,12 +1002,8 @@ TclpObjLink( } Tcl_ExternalToUtfDString(NULL, link, length, &ds); - linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - if (linkPtr != NULL) { - Tcl_IncrRefCount(linkPtr); - } + linkPtr = TclDStringToObj(&ds); + Tcl_IncrRefCount(linkPtr); return linkPtr; } } @@ -1069,19 +1065,9 @@ TclpNativeToNormalized( ClientData clientData) { Tcl_DString ds; - Tcl_Obj *objPtr; - int len; - - const char *copy; - Tcl_ExternalToUtfDString(NULL, (const char*)clientData, -1, &ds); - - copy = Tcl_DStringValue(&ds); - len = Tcl_DStringLength(&ds); - - objPtr = Tcl_NewStringObj(copy,len); - Tcl_DStringFree(&ds); - return objPtr; + Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds); + return TclDStringToObj(&ds); } /* diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 8f872d5..bc1b0e7 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -454,8 +454,7 @@ TclpInitLibraryPath( * If TCL_LIBRARY is set, search there. */ - objPtr = Tcl_NewStringObj(str, -1); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); + Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1)); Tcl_SplitPath(str, &pathc, &pathv); if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { @@ -469,9 +468,7 @@ TclpInitLibraryPath( pathv[pathc - 1] = installLib + 4; str = Tcl_JoinPath(pathc, pathv, &ds); - objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - Tcl_DStringFree(&ds); + Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds)); } ckfree(pathv); } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index aa0d665..9d0131e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1011,13 +1011,12 @@ TclpObjRemoveDirectory( } if (ret != TCL_OK) { - int len = Tcl_DStringLength(&ds); - if (len > 0) { + if (Tcl_DStringLength(&ds) > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + *errorPtr = TclDStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } @@ -1762,6 +1761,7 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); + Tcl_DStringFree(&ds); /* * Deal with issues of tildes being absolute. @@ -1771,13 +1771,11 @@ ConvertFileNameFormat( TclNewLiteralStringObj(tempPath, "./"); Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), Tcl_DStringLength(&dsTemp)); + Tcl_DStringFree(&dsTemp); } else { - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + tempPath = TclDStringToObj(&dsTemp); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsTemp); FindClose(handle); } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index dcc05bb..2cc14ec 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2350,13 +2350,9 @@ TclpFilesystemPathType( return NULL; } else { Tcl_DString ds; - Tcl_Obj *objPtr; Tcl_WinTCharToUtf(volType, -1, &ds); - objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - return objPtr; + return TclDStringToObj(&ds); } #undef VOL_BUF_SIZE } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index fb53685..3bfff63 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -299,9 +299,8 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); - str = Tcl_JoinPath(pathc, pathv, &ds); - objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + (void) Tcl_JoinPath(pathc, pathv, &ds); + objPtr = TclDStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); } -- cgit v0.12