diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdIL.c | 11 | ||||
| -rw-r--r-- | generic/tclEncoding.c | 13 | ||||
| -rw-r--r-- | generic/tclEvent.c | 7 | ||||
| -rw-r--r-- | generic/tclInt.decls | 11 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 33 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 5 | ||||
| -rw-r--r-- | generic/tclUtil.c | 163 |
8 files changed, 130 insertions, 120 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 660ceb5..cfff082 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.69 2004/11/24 19:28:41 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.70 2004/12/01 23:18:49 dgp Exp $ */ #include "tclInt.h" @@ -1499,18 +1499,11 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - CONST char *nameOfExecutable; - if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - - nameOfExecutable = Tcl_GetNameOfExecutable(); - - if (nameOfExecutable != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(nameOfExecutable, -1)); - } + Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); return TCL_OK; } diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 6932301..1d2c0b8 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEncoding.c,v 1.28 2004/12/01 21:58:59 dgp Exp $ + * RCS: @(#) $Id: tclEncoding.c,v 1.29 2004/12/01 23:18:50 dgp Exp $ */ #include "tclInt.h" @@ -301,7 +301,7 @@ TclSetEncodingSearchPath(searchPath) if (TCL_ERROR == Tcl_ListObjLength(NULL, searchPath, &dummy)) { return TCL_ERROR; } - TclSetProcessGlobalValue(&encodingSearchPath, searchPath); + TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); FillEncodingFileMap(); return TCL_OK; } @@ -349,7 +349,7 @@ TclSetLibraryPath(path) if (TCL_ERROR == Tcl_ListObjLength(NULL, path, &dummy)) { return; } - TclSetProcessGlobalValue(&libraryPath, path); + TclSetProcessGlobalValue(&libraryPath, path, NULL); } /* @@ -446,7 +446,7 @@ void FillEncodingFileMap() { Tcl_Obj *map = MakeFileMap(); - TclSetProcessGlobalValue(&encodingFileMap, map); + TclSetProcessGlobalValue(&encodingFileMap, map, NULL); Tcl_DecrRefCount(map); } @@ -1291,9 +1291,8 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst, * None. * * Side effects: - * The variable tclNativeExecutableName gets filled in with the file - * name for the application, if we figured it out. If we couldn't - * figure it out, tclNativeExecutableName is set to NULL. + * The absolute pathname for the application is computed and stored + * to be returned later be [info nameofexecutable]. * *--------------------------------------------------------------------------- */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index f180f26..62a2f3b 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.53 2004/11/30 19:34:47 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.54 2004/12/01 23:18:50 dgp Exp $ */ #include "tclInt.h" @@ -898,11 +898,6 @@ Tcl_Finalize() */ TclFinalizeEncodingSubsystem(); - if (tclNativeExecutableName != NULL) { - ckfree(tclNativeExecutableName); - tclNativeExecutableName = NULL; - } - Tcl_SetPanicProc(NULL); /* diff --git a/generic/tclInt.decls b/generic/tclInt.decls index d6cdd1f..e497298 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.83 2004/11/30 19:34:48 dgp Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.84 2004/12/01 23:18:50 dgp Exp $ library tcl @@ -850,6 +850,15 @@ declare 210 generic { declare 211 generic { CONST char * TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr) } +declare 212 generic { + void TclpFindExecutable(CONST char *argv0) +} +declare 213 generic { + Tcl_Obj * TclGetObjNameOfExecutable(void) +} +declare 214 generic { + void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) +} ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index 4510239..dbfe454 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.201 2004/11/30 19:34:48 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202 2004/12/01 23:18:51 dgp Exp $ */ #ifndef _TCLINT @@ -1913,8 +1913,6 @@ MODULE_SCOPE int TclpThreadCreate _ANSI_ARGS_(( int stackSize, int flags)); MODULE_SCOPE void TclpFinalizeThreadDataKey _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr)); -MODULE_SCOPE void TclpFindExecutable _ANSI_ARGS_(( - CONST char *argv0)); MODULE_SCOPE int TclpFindVariable _ANSI_ARGS_((CONST char *name, int *lengthPtr)); MODULE_SCOPE void TclpInitLibraryPath _ANSI_ARGS_((char **valuePtr, @@ -1987,7 +1985,8 @@ MODULE_SCOPE void TclRemoveScriptLimitCallbacks _ANSI_ARGS_(( MODULE_SCOPE void TclSetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *cmdPrefix)); MODULE_SCOPE void TclSetProcessGlobalValue _ANSI_ARGS_ (( - ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue)); + ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, + Tcl_Encoding encoding)); MODULE_SCOPE VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id, int result)); MODULE_SCOPE int TclSubstTokens _ANSI_ARGS_((Tcl_Interp *interp, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 69ddc6a..ed4b443 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.74 2004/11/30 19:34:49 dgp Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.75 2004/12/01 23:18:52 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -1102,6 +1102,22 @@ EXTERN int TclSetEncodingSearchPath _ANSI_ARGS_(( EXTERN CONST char * TclpGetEncodingNameFromEnvironment _ANSI_ARGS_(( Tcl_DString * bufPtr)); #endif +#ifndef TclpFindExecutable_TCL_DECLARED +#define TclpFindExecutable_TCL_DECLARED +/* 212 */ +EXTERN void TclpFindExecutable _ANSI_ARGS_((CONST char * argv0)); +#endif +#ifndef TclGetObjNameOfExecutable_TCL_DECLARED +#define TclGetObjNameOfExecutable_TCL_DECLARED +/* 213 */ +EXTERN Tcl_Obj * TclGetObjNameOfExecutable _ANSI_ARGS_((void)); +#endif +#ifndef TclSetObjNameOfExecutable_TCL_DECLARED +#define TclSetObjNameOfExecutable_TCL_DECLARED +/* 214 */ +EXTERN void TclSetObjNameOfExecutable _ANSI_ARGS_(( + Tcl_Obj * name, Tcl_Encoding encoding)); +#endif typedef struct TclIntStubs { int magic; @@ -1334,6 +1350,9 @@ typedef struct TclIntStubs { Tcl_Obj * (*tclGetEncodingSearchPath) _ANSI_ARGS_((void)); /* 209 */ int (*tclSetEncodingSearchPath) _ANSI_ARGS_((Tcl_Obj * searchPath)); /* 210 */ CONST char * (*tclpGetEncodingNameFromEnvironment) _ANSI_ARGS_((Tcl_DString * bufPtr)); /* 211 */ + void (*tclpFindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 212 */ + Tcl_Obj * (*tclGetObjNameOfExecutable) _ANSI_ARGS_((void)); /* 213 */ + void (*tclSetObjNameOfExecutable) _ANSI_ARGS_((Tcl_Obj * name, Tcl_Encoding encoding)); /* 214 */ } TclIntStubs; #ifdef __cplusplus @@ -2069,6 +2088,18 @@ extern TclIntStubs *tclIntStubsPtr; #define TclpGetEncodingNameFromEnvironment \ (tclIntStubsPtr->tclpGetEncodingNameFromEnvironment) /* 211 */ #endif +#ifndef TclpFindExecutable +#define TclpFindExecutable \ + (tclIntStubsPtr->tclpFindExecutable) /* 212 */ +#endif +#ifndef TclGetObjNameOfExecutable +#define TclGetObjNameOfExecutable \ + (tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */ +#endif +#ifndef TclSetObjNameOfExecutable +#define TclSetObjNameOfExecutable \ + (tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index c1c2dd0..83218f9 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.108 2004/11/30 19:34:49 dgp Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.109 2004/12/01 23:18:53 dgp Exp $ */ #include "tclInt.h" @@ -296,6 +296,9 @@ TclIntStubs tclIntStubs = { TclGetEncodingSearchPath, /* 209 */ TclSetEncodingSearchPath, /* 210 */ TclpGetEncodingNameFromEnvironment, /* 211 */ + TclpFindExecutable, /* 212 */ + TclGetObjNameOfExecutable, /* 213 */ + TclSetObjNameOfExecutable, /* 214 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9737c4a..7bf4b41 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,37 +11,16 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.49 2004/11/30 19:34:50 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.50 2004/12/01 23:18:54 dgp Exp $ */ #include "tclInt.h" /* - * The following variables hold the full path name of the binary - * from which this application was executed, or NULL if it isn't - * know. The values are set by the procedure Tcl_FindExecutable. - * Only the first call to Tcl_FindExecutable sets the value. That - * call also sets the "searchDone" flag, so that subsequent calls - * are no-ops. With that logic in place, no mutex protection is - * required. The storage space is dynamically allocated. The value - * is kept in the system encoding. + * The absolute pathname of the executable in which this Tcl library + * is running. */ - -char *tclNativeExecutableName = NULL; -int tclFindExecutableSearchDone = 0; - -/* - * A copy of the executable path name, converted to Tcl's internal - * encoding, UTF-8. Also keep a copy of what the system encoding - * was believed to be when the conversion was done, just in case - * it's changed on us. Because Tcl_GetNameOfExecutable() is in - * the public API, it might be called from any thread, so we need - * mutex protection here. - */ - -TCL_DECLARE_MUTEX(executableNameMutex) -static char *executableName = NULL; -static Tcl_Encoding conversionEncoding = NULL; +static ProcessGlobalValue executableName = {0, 0, NULL, NULL, NULL, NULL, NULL}; /* * The following values are used in the flags returned by Tcl_ScanElement @@ -90,7 +69,6 @@ TCL_DECLARE_MUTEX(precisionMutex) */ static void ClearHash _ANSI_ARGS_((Tcl_HashTable *tablePtr)); -static void FreeExecutableName _ANSI_ARGS_((ClientData)); static void FreeProcessGlobalValue _ANSI_ARGS_(( ClientData clientData)); static void FreeThreadHash _ANSI_ARGS_ ((ClientData clientData)); @@ -98,7 +76,6 @@ static Tcl_HashTable * GetThreadHash _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr)); static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* objPtr)); static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr)); -static Tcl_Obj * Tcl_GetObjNameOfExecutable(); /* * The following is the Tcl object type definition for an object @@ -2700,9 +2677,10 @@ FreeProcessGlobalValue(clientData) *---------------------------------------------------------------------- */ void -TclSetProcessGlobalValue(pgvPtr, newValue) +TclSetProcessGlobalValue(pgvPtr, newValue, encoding) ProcessGlobalValue *pgvPtr; Tcl_Obj *newValue; + Tcl_Encoding encoding; { CONST char *bytes; Tcl_HashTable *cacheMap; @@ -2722,8 +2700,8 @@ TclSetProcessGlobalValue(pgvPtr, newValue) strcpy(pgvPtr->value, bytes); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); - pgvPtr->encoding = NULL; } + pgvPtr->encoding = encoding; /* * Fill the local thread copy directly with the Tcl_Obj @@ -2820,88 +2798,91 @@ TclGetProcessGlobalValue(pgvPtr) /* *---------------------------------------------------------------------- * - * Tcl_GetNameOfExecutable -- - * - * This procedure simply returns a pointer to the internal full - * path name of the executable file as computed by - * Tcl_FindExecutable. This procedure call is the C API - * equivalent to the "info nameofexecutable" command. + * TclSetObjNameOfExecutable -- * - * TODO: Rework these routines to use a ProcessGlobalValue. + * This procedure stores the absolute pathname of + * the executable file (normally as computed by + * TclpFindExecutable). * * Results: - * A pointer to the internal string or NULL if the internal full - * path name has not been computed or unknown. + * None. * * Side effects: - * The object referenced by "objPtr" might be converted to an - * integer object. + * Stores the executable name. * *---------------------------------------------------------------------- */ -static void -FreeExecutableName(clientData) - ClientData clientData; +void +TclSetObjNameOfExecutable(name, encoding) + Tcl_Obj *name; + Tcl_Encoding encoding; { - Tcl_FreeEncoding(conversionEncoding); - conversionEncoding = NULL; - if (NULL != executableName) { - ckfree(executableName); - } - executableName = NULL; + TclSetProcessGlobalValue(&executableName, name, encoding); } + +/* + *---------------------------------------------------------------------- + * + * TclGetObjNameOfExecutable -- + * + * This procedure retrieves the absolute pathname of the + * application in which the Tcl library is running, usually + * as previously stored by TclpFindExecutable(). + * This procedure call is the C API equivalent to the + * "info nameofexecutable" command. + * + * Results: + * A pointer to an "fsPath" Tcl_Obj, or to an empty Tcl_Obj if + * the pathname of the application is unknown. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ -static Tcl_Obj * -Tcl_GetObjNameOfExecutable() +Tcl_Obj * +TclGetObjNameOfExecutable() { - Tcl_Obj *result; - - Tcl_MutexLock(&executableNameMutex); - if (NULL == conversionEncoding) { - /* First call (after free) */ - conversionEncoding = Tcl_GetEncoding(NULL, NULL); - Tcl_CreateExitHandler(FreeExecutableName, NULL); - } else { - /* Later call... */ - Tcl_Encoding systemEncoding = Tcl_GetEncoding(NULL, NULL); - if (systemEncoding != conversionEncoding) { - /* ...with system encoding changed */ - FreeExecutableName(NULL); - conversionEncoding = systemEncoding; - } else { - Tcl_FreeEncoding(systemEncoding); - } - } - if (NULL == tclNativeExecutableName) { - FreeExecutableName(NULL); - } else if (NULL == executableName) { - Tcl_DString ds; - Tcl_ExternalToUtfDString(conversionEncoding, - tclNativeExecutableName, -1, &ds); - executableName = (char *) - ckalloc ((unsigned) Tcl_DStringLength(&ds) + 1); - strcpy(executableName, Tcl_DStringValue(&ds)); - Tcl_DStringFree(&ds); - } - - if (NULL == executableName) { - result = Tcl_NewObj(); - } else { - result = Tcl_NewStringObj(executableName, -1); - } - Tcl_MutexUnlock(&executableNameMutex); - return result; + return TclGetProcessGlobalValue(&executableName); } + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetNameOfExecutable -- + * + * This procedure retrieves the absolute pathname of the + * application in which the Tcl library is running, and + * returns it in string form. + * + * The returned string belongs to Tcl and should be copied + * if the caller plans to keep it, to guard against it + * becoming invalid. + * + * Results: + * A pointer to the internal string or NULL if the internal full + * path name has not been computed or unknown. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ CONST char * Tcl_GetNameOfExecutable() { - Tcl_DecrRefCount(Tcl_GetObjNameOfExecutable()); - return executableName; + int numBytes; + CONST char * bytes = + Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes); + if (numBytes == 0) { + return NULL; + } + return bytes; } - /* *---------------------------------------------------------------------- * |