summaryrefslogtreecommitdiffstats
path: root/win/tclWinInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinInit.c')
-rw-r--r--win/tclWinInit.c200
1 files changed, 122 insertions, 78 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index f0c2a9e..8b600f6 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -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.75 2007/12/13 15:28:44 dgp 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.
*
@@ -128,20 +130,16 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst);
void
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
/*
@@ -177,10 +175,10 @@ TclpInitLibraryPath(
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,9 +206,16 @@ TclpInitLibraryPath(
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);
+ *valuePtr = ckalloc((*lengthPtr) + 1);
memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -237,14 +242,14 @@ TclpInitLibraryPath(
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;
/*
@@ -290,8 +295,6 @@ AppendEnvironment(
*/
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);
}
}
@@ -357,7 +359,7 @@ InitializeDefaultLibraryDir(
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(*valuePtr, name, (size_t) *lengthPtr + 1);
}
@@ -365,9 +367,11 @@ InitializeDefaultLibraryDir(
/*
*---------------------------------------------------------------------------
*
- * 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(
*---------------------------------------------------------------------------
*/
-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(void)
+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);
}
/*
@@ -454,18 +482,13 @@ TclpSetInitialEncodings(void)
Tcl_DStringFree(&encodingName);
}
-void
-TclpSetInterfaces(void)
+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 *
+const char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
@@ -497,23 +520,35 @@ void
TclpSetVariables(
Tcl_Interp *interp) /* Interp to initialize. */
{
- CONST char *ptr;
+ const char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
- SYSTEM_INFO sysInfo, *sysInfoPtr = &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 *) sysInfoPtr;
- 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.
@@ -527,9 +562,9 @@ TclpSetVariables(
}
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);
}
@@ -573,17 +608,26 @@ TclpSetVariables(
/*
* 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);
}
/*
@@ -608,7 +652,7 @@ TclpSetVariables(
int
TclpFindVariable(
- CONST char *name, /* Name of desired environment variable
+ const char *name, /* Name of desired environment variable
* (UTF-8). */
int *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
@@ -616,7 +660,7 @@ TclpFindVariable(
* searches). */
{
int i, length, result = -1;
- register CONST char *env, *p1, *p2;
+ register const char *env, *p1, *p2;
char *envUpper, *nameUpper;
Tcl_DString envString;
@@ -625,7 +669,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = (char *) ckalloc((unsigned) length+1);
+ nameUpper = ckalloc(length + 1);
memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
generated by cgit v0.12 at 2025-10-22 13:36:59 (GMT)