summaryrefslogtreecommitdiffstats
path: root/win/tclWinInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinInit.c')
-rw-r--r--win/tclWinInit.c153
1 files changed, 91 insertions, 62 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2e7b2dd..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"
};
@@ -105,16 +105,16 @@ 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);
+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.
*
@@ -130,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
/*
@@ -176,13 +172,13 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- size_t *lengthPtr,
+ int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 64
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
- const char *bytes;
+ char *bytes;
pathPtr = Tcl_NewObj();
@@ -219,8 +215,8 @@ TclpInitLibraryPath(
*encodingPtr = NULL;
bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, bytes, (*lengthPtr)+1);
+ *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
+ memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -246,14 +242,14 @@ TclpInitLibraryPath(
static void
AppendEnvironment(
Tcl_Obj *pathPtr,
- const char *lib)
+ CONST char *lib)
{
- size_t pathc;
+ 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;
/*
@@ -287,7 +283,7 @@ AppendEnvironment(
}
if (buf[0] != '\0') {
- objPtr = Tcl_NewStringObj(buf, TCL_STRLEN);
+ objPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
TclWinNoBackslash(buf);
@@ -299,6 +295,8 @@ 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
@@ -308,13 +306,14 @@ AppendEnvironment(
pathv[pathc - 1] = shortlib;
Tcl_DStringInit(&ds);
- (void) Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = TclDStringToObj(&ds);
+ str = Tcl_JoinPath(pathc, pathv, &ds);
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
} else {
- objPtr = Tcl_NewStringObj(buf, TCL_STRLEN);
+ objPtr = Tcl_NewStringObj(buf, -1);
}
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- ckfree(pathv);
+ ckfree((char *) pathv);
}
}
@@ -414,7 +413,7 @@ InitializeSourceLibraryDir(
TclWinNoBackslash(name);
sprintf(end + 1, "../library");
*lengthPtr = strlen(name);
- *valuePtr = ckalloc(*lengthPtr + 1);
+ *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
*encodingPtr = NULL;
memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}
@@ -437,7 +436,7 @@ InitializeSourceLibraryDir(
static int
ToUtf(
- const WCHAR *wSrc,
+ CONST WCHAR *wSrc,
char *dst)
{
char *start;
@@ -454,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
@@ -489,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)
{
@@ -527,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);
/*
@@ -564,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
@@ -587,11 +624,11 @@ TclpSetVariables(
if (ptr == NULL) {
ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
if (ptr != NULL) {
- Tcl_DStringAppend(&ds, ptr, TCL_STRLEN);
+ Tcl_DStringAppend(&ds, ptr, -1);
}
ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
if (ptr != NULL) {
- Tcl_DStringAppend(&ds, ptr, TCL_STRLEN);
+ Tcl_DStringAppend(&ds, ptr, -1);
}
if (Tcl_DStringLength(&ds) > 0) {
Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
@@ -609,22 +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);
}
/*
@@ -649,16 +679,15 @@ TclpSetVariables(
int
TclpFindVariable(
- const char *name, /* Name of desired environment variable
+ CONST char *name, /* Name of desired environment variable
* (UTF-8). */
- size_t *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, result = -1;
- size_t length;
- register const char *env, *p1, *p2;
+ int i, length, result = -1;
+ register CONST char *env, *p1, *p2;
char *envUpper, *nameUpper;
Tcl_DString envString;
@@ -667,8 +696,8 @@ TclpFindVariable(
*/
length = strlen(name);
- nameUpper = ckalloc(length + 1);
- memcpy(nameUpper, name, length+1);
+ nameUpper = (char *) ckalloc((unsigned) length+1);
+ memcpy(nameUpper, name, (size_t) length+1);
Tcl_UtfToUpper(nameUpper);
Tcl_DStringInit(&envString);
@@ -679,7 +708,7 @@ TclpFindVariable(
* after the equal sign.
*/
- envUpper = Tcl_ExternalToUtfDString(NULL,env,TCL_STRLEN, &envString);
+ envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
p1 = strchr(envUpper, '=');
if (p1 == NULL) {
continue;
generated by cgit v0.12 at 2025-12-18 16:29:57 (GMT)