summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdIL.c11
-rw-r--r--generic/tclEncoding.c13
-rw-r--r--generic/tclEvent.c7
-rw-r--r--generic/tclInt.decls11
-rw-r--r--generic/tclInt.h7
-rw-r--r--generic/tclIntDecls.h33
-rw-r--r--generic/tclStubInit.c5
-rw-r--r--generic/tclUtil.c163
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;
}
-
/*
*----------------------------------------------------------------------
*