summaryrefslogtreecommitdiffstats
path: root/win/tclWinInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinInit.c')
-rw-r--r--win/tclWinInit.c186
1 files changed, 138 insertions, 48 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index fb53685..4e860b2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -83,12 +83,12 @@ typedef struct {
#define NUMPLATFORMS 4
-static const char *const platforms[NUMPLATFORMS] = {
+static char* platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT", "Windows CE"
};
#define NUMPROCESSORS 11
-static const char *const processors[NUMPROCESSORS] = {
+static char* processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
"amd64", "ia32_on_win64"
};
@@ -101,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,20 +130,16 @@ static int ToUtf(const WCHAR *wSrc, char *dst);
void
TclpInitPlatform(void)
{
- tclPlatform = TCL_PLATFORM_WINDOWS;
+ WSADATA wsaData;
+ WORD wVersionRequested = MAKEWORD(2, 2);
- /*
- * 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.
- */
+ tclPlatform = TCL_PLATFORM_WINDOWS;
- SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+ /*
+ * Initialize the winsock library. On Windows XP and higher this
+ * can never fail.
+ */
+ WSAStartup(wVersionRequested, &wsaData);
#ifdef STATIC_BUILD
/*
@@ -175,10 +175,10 @@ TclpInitLibraryPath(
int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
-#define LIBRARY_SIZE 32
+#define LIBRARY_SIZE 64
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
- const char *bytes;
+ char *bytes;
pathPtr = Tcl_NewObj();
@@ -206,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((*lengthPtr) + 1);
+ *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -235,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;
/*
@@ -288,7 +295,7 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
- const char *str;
+ CONST char *str;
/*
* TCL_LIBRARY is set but refers to a different tcl installation
@@ -306,7 +313,7 @@ AppendEnvironment(
objPtr = Tcl_NewStringObj(buf, -1);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree(pathv);
+ ckfree((char *) pathv);
}
}
@@ -363,6 +370,57 @@ InitializeDefaultLibraryDir(
/*
*---------------------------------------------------------------------------
*
+ * InitializeSourceLibraryDir --
+ *
+ * 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitializeSourceLibraryDir(
+ char **valuePtr,
+ int *lengthPtr,
+ Tcl_Encoding *encodingPtr)
+{
+ HMODULE hModule = TclWinGetTclInstance();
+ WCHAR wName[MAX_PATH + LIBRARY_SIZE];
+ char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+ char *end, *p;
+
+ if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
+ GetModuleFileNameA(hModule, name, MAX_PATH);
+ } else {
+ ToUtf(wName, name);
+ }
+
+ 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((unsigned int) *lengthPtr + 1);
+ *encodingPtr = NULL;
+ memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* ToUtf --
*
* Convert a char string to a UTF string.
@@ -378,7 +436,7 @@ InitializeDefaultLibraryDir(
static int
ToUtf(
- const WCHAR *wSrc,
+ CONST WCHAR *wSrc,
char *dst)
{
char *start;
@@ -395,6 +453,31 @@ ToUtf(
/*
*---------------------------------------------------------------------------
*
+ * TclWinEncodingsCleanup --
+ *
+ * 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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Static information reset to startup state.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclWinEncodingsCleanup(void)
+{
+ TclWinResetInterfaceEncodings();
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* TclpSetInitialEncodings --
*
* Based on the locale, determine the encoding of the operating system
@@ -430,13 +513,15 @@ TclpSetInitialEncodings(void)
void
TclpSetInterfaces(void)
{
- int useWide;
+ int platformId, useWide;
- useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS);
+ platformId = TclWinGetPlatformId();
+ useWide = ((platformId == VER_PLATFORM_WIN32_NT)
+ || (platformId == VER_PLATFORM_WIN32_CE));
TclWinSetInterfaces(useWide);
}
-const char *
+CONST char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
@@ -468,23 +553,34 @@ void
TclpSetVariables(
Tcl_Interp *interp) /* Interp to initialize. */
{
- const char *ptr;
+ CONST char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
union {
SYSTEM_INFO info;
OemId oemId;
} sys;
- OSVERSIONINFOA osInfo;
+ static OSVERSIONINFOW osInfo;
+ static int osInfoInitialized = 0;
Tcl_DString ds;
- TCHAR szUserName[UNLEN+1];
+ WCHAR szUserName[UNLEN+1];
DWORD cchUserNameLen = UNLEN;
Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);
- osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
- GetVersionExA(&osInfo);
-
+ 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);
/*
@@ -505,7 +601,7 @@ TclpSetVariables(
TCL_GLOBAL_ONLY);
}
-#ifdef _DEBUG
+#ifndef NDEBUG
/*
* The existence of the "debug" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with debug
@@ -550,21 +646,15 @@ TclpSetVariables(
Tcl_DStringInit(&ds);
if (TclGetEnv("USERNAME", &ds) == NULL) {
- if (GetUserName(szUserName, &cchUserNameLen) != 0) {
+ if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) {
int cbUserNameLen = cchUserNameLen - 1;
- cbUserNameLen *= sizeof(TCHAR);
- Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds);
+ if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR);
+ Tcl_WinTCharToUtf((LPTSTR)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);
}
/*
@@ -589,7 +679,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
@@ -597,7 +687,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;
@@ -606,7 +696,7 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = ckalloc(length + 1);
+ nameUpper = (char *) ckalloc((unsigned) length+1);
memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
generated by cgit v0.12 at 2025-12-21 01:27:38 (GMT)