summaryrefslogtreecommitdiffstats
path: root/win/tclWinInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinInit.c')
-rw-r--r--win/tclWinInit.c254
1 files changed, 150 insertions, 104 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index a46fc80..8b600f6 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclWinInit.c --
*
* Contains the Windows-specific interpreter initialization functions.
@@ -9,8 +9,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinInit.c,v 1.67 2005/07/24 22:56:48 dkf Exp $
*/
#include "tclWinInt.h"
@@ -85,12 +83,12 @@ typedef struct {
#define NUMPLATFORMS 4
-static char* platforms[NUMPLATFORMS] = {
+static const char *const platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT", "Windows CE"
};
#define NUMPROCESSORS 11
-static char* processors[NUMPROCESSORS] = {
+static const char *const processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
"amd64", "ia32_on_win64"
};
@@ -103,16 +101,20 @@ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir;
static ProcessGlobalValue defaultLibraryDir =
{0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};
-static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
-static int ToUtf(CONST WCHAR *wSrc, char *dst);
+static TclInitProcessGlobalValueProc InitializeSourceLibraryDir;
+static ProcessGlobalValue sourceLibraryDir =
+ {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
+
+static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
+static int ToUtf(const WCHAR *wSrc, char *dst);
/*
*---------------------------------------------------------------------------
*
* TclpInitPlatform --
*
- * Initialize all the platform-dependant things like signals and
- * floating-point error handling.
+ * Initialize all the platform-dependant things like signals,
+ * floating-point error handling and sockets.
*
* Called at process initialization time.
*
@@ -126,22 +128,18 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst);
*/
void
-TclpInitPlatform()
+TclpInitPlatform(void)
{
+ WSADATA wsaData;
+ WORD wVersionRequested = MAKEWORD(2, 2);
+
tclPlatform = TCL_PLATFORM_WINDOWS;
/*
- * The following code stops Windows 3.X and Windows NT 3.51 from
- * automatically putting up Sharing Violation dialogs, e.g, when someone
- * tries to access a file that is locked or a drive with no disk in it.
- * Tcl already returns the appropriate error to the caller, and they can
- * decide to put up their own dialog in response to that failure.
- *
- * Under 95 and NT 4.0, this is a NOOP because the system doesn't
- * automatically put up dialogs when the above operations fail.
+ * Initialize the winsock library. On Windows XP and higher this
+ * can never fail.
*/
-
- SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+ WSAStartup(wVersionRequested, &wsaData);
#ifdef STATIC_BUILD
/*
@@ -166,21 +164,21 @@ TclpInitPlatform()
* None.
*
* Side effects:
- * Sets the library path to an initial value.
+ * Sets the library path to an initial value.
*
*-------------------------------------------------------------------------
- */
+ */
void
-TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr)
- char **valuePtr;
- int *lengthPtr;
- Tcl_Encoding *encodingPtr;
+TclpInitLibraryPath(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
-#define LIBRARY_SIZE 32
+#define LIBRARY_SIZE 64
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
- char *bytes;
+ const char *bytes;
pathPtr = Tcl_NewObj();
@@ -208,10 +206,17 @@ TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr)
Tcl_ListObjAppendElement(NULL, pathPtr,
TclGetProcessGlobalValue(&defaultLibraryDir));
+ /*
+ * Look for the library in its source checkout location.
+ */
+
+ Tcl_ListObjAppendElement(NULL, pathPtr,
+ TclGetProcessGlobalValue(&sourceLibraryDir));
+
*encodingPtr = NULL;
bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
- memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t)(*lengthPtr)+1);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
+ memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -237,14 +242,14 @@ TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr)
static void
AppendEnvironment(
Tcl_Obj *pathPtr,
- CONST char *lib)
+ const char *lib)
{
int pathc;
WCHAR wBuf[MAX_PATH];
char buf[MAX_PATH * TCL_UTF_MAX];
Tcl_Obj *objPtr;
Tcl_DString ds;
- CONST char **pathv;
+ const char **pathv;
char *shortlib;
/*
@@ -284,14 +289,12 @@ AppendEnvironment(
TclWinNoBackslash(buf);
Tcl_SplitPath(buf, &pathc, &pathv);
- /*
+ /*
* The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8
* chars because I know shortlib is ascii.
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- CONST char *str;
-
/*
* TCL_LIBRARY is set but refers to a different tcl installation
* than the current version. Try fiddling with the specified
@@ -301,14 +304,13 @@ 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);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree((char *) pathv);
+ ckfree(pathv);
}
}
@@ -330,10 +332,10 @@ AppendEnvironment(
*/
static void
-InitializeDefaultLibraryDir(valuePtr, lengthPtr, encodingPtr)
- char **valuePtr;
- int *lengthPtr;
- Tcl_Encoding *encodingPtr;
+InitializeDefaultLibraryDir(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
HMODULE hModule = TclWinGetTclInstance();
WCHAR wName[MAX_PATH + LIBRARY_SIZE];
@@ -357,17 +359,19 @@ InitializeDefaultLibraryDir(valuePtr, lengthPtr, encodingPtr)
TclWinNoBackslash(name);
sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
*lengthPtr = strlen(name);
- *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
+ *valuePtr = ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
- memcpy((VOID *) *valuePtr, (VOID *) name, (size_t) *lengthPtr + 1);
+ memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
/*
*---------------------------------------------------------------------------
*
- * ToUtf --
+ * InitializeSourceLibraryDir --
*
- * Convert a char string to a UTF string.
+ * Locate the Tcl script library default location relative to the
+ * location of the Tcl DLL as it exists in the build output directory
+ * associated with the source checkout.
*
* Results:
* None.
@@ -378,45 +382,69 @@ InitializeDefaultLibraryDir(valuePtr, lengthPtr, encodingPtr)
*---------------------------------------------------------------------------
*/
-static int
-ToUtf(
- CONST WCHAR *wSrc,
- char *dst)
+static void
+InitializeSourceLibraryDir(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
{
- char *start;
+ HMODULE hModule = TclWinGetTclInstance();
+ WCHAR wName[MAX_PATH + LIBRARY_SIZE];
+ char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+ char *end, *p;
- start = dst;
- while (*wSrc != '\0') {
- dst += Tcl_UniCharToUtf(*wSrc, dst);
- wSrc++;
+ if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
+ GetModuleFileNameA(hModule, name, MAX_PATH);
+ } else {
+ ToUtf(wName, name);
}
- *dst = '\0';
- return (int) (dst - start);
+
+ end = strrchr(name, '\\');
+ *end = '\0';
+ p = strrchr(name, '\\');
+ if (p != NULL) {
+ end = p;
+ }
+ *end = '\\';
+
+ TclWinNoBackslash(name);
+ sprintf(end + 1, "../library");
+ *lengthPtr = strlen(name);
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ *encodingPtr = NULL;
+ memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
/*
*---------------------------------------------------------------------------
*
- * TclWinEncodingsCleanup --
+ * ToUtf --
*
- * Reset information to its original state in finalization to allow for
- * reinitialization to be possible. This must not be called until after
- * the filesystem has been finalised, or exit crashes may occur when
- * using virtual filesystems.
+ * Convert a char string to a UTF string.
*
* Results:
* None.
*
* Side effects:
- * Static information reset to startup state.
+ * None.
*
*---------------------------------------------------------------------------
*/
-void
-TclWinEncodingsCleanup()
+static int
+ToUtf(
+ const WCHAR *wSrc,
+ char *dst)
{
- TclWinResetInterfaceEncodings();
+ char *start;
+
+ start = dst;
+ while (*wSrc != '\0') {
+ dst += Tcl_UniCharToUtf(*wSrc, dst);
+ wSrc++;
+ }
+ *dst = '\0';
+ return (int) (dst - start);
}
/*
@@ -444,33 +472,30 @@ TclWinEncodingsCleanup()
*/
void
-TclpSetInitialEncodings()
+TclpSetInitialEncodings(void)
{
Tcl_DString encodingName;
-
+
TclpSetInterfaces();
Tcl_SetSystemEncoding(NULL,
- TclpGetEncodingNameFromEnvironment(&encodingName));
+ Tcl_GetEncodingNameFromEnvironment(&encodingName));
Tcl_DStringFree(&encodingName);
}
-void
-TclpSetInterfaces()
+void TclWinSetInterfaces(
+ int dummy) /* Not used. */
{
- int platformId, useWide;
-
- platformId = TclWinGetPlatformId();
- useWide = ((platformId == VER_PLATFORM_WIN32_NT)
- || (platformId == VER_PLATFORM_WIN32_CE));
- TclWinSetInterfaces(useWide);
+ TclpSetInterfaces();
}
-CONST char *
-TclpGetEncodingNameFromEnvironment(bufPtr)
- Tcl_DString *bufPtr;
+const char *
+Tcl_GetEncodingNameFromEnvironment(
+ Tcl_DString *bufPtr)
{
Tcl_DStringInit(bufPtr);
+ Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
+ Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
return Tcl_DStringValue(bufPtr);
}
@@ -492,26 +517,38 @@ TclpGetEncodingNameFromEnvironment(bufPtr)
*/
void
-TclpSetVariables(interp)
- Tcl_Interp *interp; /* Interp to initialize. */
+TclpSetVariables(
+ Tcl_Interp *interp) /* Interp to initialize. */
{
- CONST char *ptr;
+ const char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
- SYSTEM_INFO sysInfo;
- OemId *oemId;
- OSVERSIONINFOA osInfo;
+ union {
+ SYSTEM_INFO info;
+ OemId oemId;
+ } sys;
+ static OSVERSIONINFOW osInfo;
+ static int osInfoInitialized = 0;
Tcl_DString ds;
TCHAR szUserName[UNLEN+1];
- DWORD dwUserNameLen = sizeof(szUserName);
+ DWORD cchUserNameLen = UNLEN;
Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);
- osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
- GetVersionExA(&osInfo);
-
- oemId = (OemId *) &sysInfo;
- GetSystemInfo(&sysInfo);
+ if (!osInfoInitialized) {
+ HANDLE handle = LoadLibraryW(L"NTDLL");
+ int(__stdcall *getversion)(void *) =
+ (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion");
+ osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
+ if (!getversion || getversion(&osInfo)) {
+ GetVersionExW(&osInfo);
+ }
+ if (handle) {
+ FreeLibrary(handle);
+ }
+ osInfoInitialized = 1;
+ }
+ GetSystemInfo(&sys.info);
/*
* Define the tcl_platform array.
@@ -525,9 +562,9 @@ TclpSetVariables(interp)
}
wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
- if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
+ if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
- processors[oemId->wProcessorArchitecture],
+ processors[sys.oemId.wProcessorArchitecture],
TCL_GLOBAL_ONLY);
}
@@ -571,17 +608,26 @@ TclpSetVariables(interp)
/*
* Initialize the user name from the environment first, since this is much
* faster than asking the system.
+ * Note: cchUserNameLen is number of characters including nul terminator.
*/
Tcl_DStringInit(&ds);
if (TclGetEnv("USERNAME", &ds) == NULL) {
- if (GetUserName(szUserName, &dwUserNameLen) != 0) {
- Tcl_WinTCharToUtf(szUserName, (int) dwUserNameLen, &ds);
+ if (GetUserName(szUserName, &cchUserNameLen) != 0) {
+ int cbUserNameLen = cchUserNameLen - 1;
+ cbUserNameLen *= sizeof(TCHAR);
+ Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds);
}
}
Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
+
+ /*
+ * Define what the platform PATH separator is. [TIP #315]
+ */
+
+ Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
}
/*
@@ -590,7 +636,7 @@ TclpSetVariables(interp)
* TclpFindVariable --
*
* Locate the entry in environ for a given name. On Unix this routine is
- * case sensetive, on Windows this matches mioxed case.
+ * case sensitive, on Windows this matches mioxed case.
*
* Results:
* The return value is the index in environ of an entry with the name
@@ -605,16 +651,16 @@ TclpSetVariables(interp)
*/
int
-TclpFindVariable(name, lengthPtr)
- CONST char *name; /* Name of desired environment variable
+TclpFindVariable(
+ const char *name, /* Name of desired environment variable
* (UTF-8). */
- int *lengthPtr; /* Used to return length of name (for
+ int *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
* entries in environ (for unsuccessful
* searches). */
{
int i, length, result = -1;
- register CONST char *env, *p1, *p2;
+ register const char *env, *p1, *p2;
char *envUpper, *nameUpper;
Tcl_DString envString;
@@ -623,8 +669,8 @@ TclpFindVariable(name, lengthPtr)
*/
length = strlen(name);
- nameUpper = (char *) ckalloc((unsigned) length+1);
- memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
+ nameUpper = ckalloc(length + 1);
+ memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
Tcl_DStringInit(&envString);
generated by cgit v0.12 at 2025-10-21 15:51:53 (GMT)