summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixInit.c')
-rw-r--r--unix/tclUnixInit.c823
1 files changed, 544 insertions, 279 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index b15f80a..a8cd00d 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -3,20 +3,22 @@
*
* Contains the Unix-specific interpreter initialization functions.
*
- * Copyright © 1995-1997 Sun Microsystems, Inc.
- * Copyright © 1999 Scriptics Corporation.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
*/
#include "tclInt.h"
+#include <stddef.h>
+#include <locale.h>
#ifdef HAVE_LANGINFO
# include <langinfo.h>
# ifdef __APPLE__
-# if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030
+# if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/* Support for weakly importing nl_langinfo on Darwin. */
-# define WEAK_IMPORT_NL_LANGINFO
+# define WEAK_IMPORT_NL_LANGINFO
extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE;
-# endif
+# endif
# endif
#endif
#include <sys/resource.h>
@@ -31,53 +33,49 @@
#endif
#ifdef __CYGWIN__
-#ifdef __cplusplus
-extern "C" {
-#endif
-#ifdef __clang__
-#pragma clang diagnostic ignored "-Wignored-attributes"
-#endif
DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *);
-DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *);
+DLLIMPORT extern __stdcall void *LoadLibraryW(const void *);
DLLIMPORT extern __stdcall void FreeLibrary(void *);
DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *);
DLLIMPORT extern __stdcall void GetSystemInfo(void *);
-#ifdef __cplusplus
-}
-#endif
-#define NUMPROCESSORS 15
-static const char *const processors[NUMPROCESSORS] = {
- "i686", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
- "x86_64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64"
+#define NUMPLATFORMS 4
+static const char *const platforms[NUMPLATFORMS] = {
+ "Win32s", "Windows 95", "Windows NT", "Windows CE"
+};
+
+#define NUMPROCESSORS 11
+static const char *const processors[NUMPROCESSORS] = {
+ "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
+ "amd64", "ia32_on_win64"
};
-typedef struct {
- union {
- unsigned int dwOemId;
- struct {
- int wProcessorArchitecture;
- int wReserved;
- };
+typedef struct _SYSTEM_INFO {
+ union {
+ DWORD dwOemId;
+ struct {
+ int wProcessorArchitecture;
+ int wReserved;
};
- unsigned int dwPageSize;
- void *lpMinimumApplicationAddress;
- void *lpMaximumApplicationAddress;
- void *dwActiveProcessorMask;
- unsigned int dwNumberOfProcessors;
- unsigned int dwProcessorType;
- unsigned int dwAllocationGranularity;
- int wProcessorLevel;
- int wProcessorRevision;
+ };
+ DWORD dwPageSize;
+ void *lpMinimumApplicationAddress;
+ void *lpMaximumApplicationAddress;
+ void *dwActiveProcessorMask;
+ DWORD dwNumberOfProcessors;
+ DWORD dwProcessorType;
+ DWORD dwAllocationGranularity;
+ int wProcessorLevel;
+ int wProcessorRevision;
} SYSTEM_INFO;
-typedef struct {
- unsigned int dwOSVersionInfoSize;
- unsigned int dwMajorVersion;
- unsigned int dwMinorVersion;
- unsigned int dwBuildNumber;
- unsigned int dwPlatformId;
- wchar_t szCSDVersion[128];
+typedef struct _OSVERSIONINFOW {
+ DWORD dwOSVersionInfoSize;
+ DWORD dwMajorVersion;
+ DWORD dwMinorVersion;
+ DWORD dwBuildNumber;
+ DWORD dwPlatformId;
+ wchar_t szCSDVersion[128];
} OSVERSIONINFOW;
#endif
@@ -86,6 +84,64 @@ typedef struct {
#endif
/*
+ * Define TCL_NO_STACK_CHECK in the compiler options if you want to revert to
+ * the old behavior of never checking the stack.
+ */
+
+/*
+ * Define this if you want to see a lot of output regarding stack checking.
+ */
+
+#undef TCL_DEBUG_STACK_CHECK
+
+/*
+ * Values used to compute how much space is really available for Tcl's use for
+ * the stack.
+ *
+ * The getrlimit() function is documented to return the maximum stack size in
+ * bytes. However, with threads enabled, the pthread library on some platforms
+ * does bad things to the stack size limits. First, the limits cannot be
+ * changed. Second, they appear to be sometimes reported incorrectly.
+ *
+ * The defines below may need to be adjusted if more platforms have this
+ * broken behavior with threads enabled.
+ */
+
+#ifndef TCL_MAGIC_STACK_DIVISOR
+#define TCL_MAGIC_STACK_DIVISOR 1
+#endif
+#ifndef TCL_RESERVED_STACK_PAGES
+#define TCL_RESERVED_STACK_PAGES 8
+#endif
+
+/*
+ * Thread specific data for stack checking.
+ */
+
+#ifndef TCL_NO_STACK_CHECK
+typedef struct ThreadSpecificData {
+ int *outerVarPtr; /* The "outermost" stack frame pointer for
+ * this thread. */
+ int *stackBound; /* The current stack boundary */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+#ifdef TCL_CROSS_COMPILE
+static int stackGrowsDown = -1;
+static int StackGrowsDown(int *parent);
+#elif defined(TCL_STACK_GROWS_UP)
+#define stackGrowsDown 0
+#else
+#define stackGrowsDown 1
+#endif
+#endif /* TCL_NO_STACK_CHECK */
+
+#ifdef TCL_DEBUG_STACK_CHECK
+#define STACK_DEBUG(args) printf args
+#else
+#define STACK_DEBUG(args) (void)0
+#endif /* TCL_DEBUG_STACK_CHECK */
+
+/*
* Tcl tries to use standard and homebrew methods to guess the right encoding
* on the platform. However, there is always a final fallback, and this value
* is it. Make sure it is a real Tcl encoding.
@@ -100,7 +156,7 @@ typedef struct {
* defined by Makefile.
*/
-static const char defaultLibraryDir[] = TCL_LIBRARY;
+static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY;
/*
* Directory in which to look for packages (each package is typically
@@ -108,7 +164,7 @@ static const char defaultLibraryDir[] = TCL_LIBRARY;
* Makefile.
*/
-static const char pkgPath[] = TCL_PACKAGE_PATH;
+static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
/*
* The following table is used to map from Unix locale strings to encoding
@@ -117,9 +173,9 @@ static const char pkgPath[] = TCL_PACKAGE_PATH;
* first list checked for a mapping from env encoding to Tcl encoding name.
*/
-typedef struct {
- const char *lang;
- const char *encoding;
+typedef struct LocaleTable {
+ CONST char *lang;
+ CONST char *encoding;
} LocaleTable;
/*
@@ -132,10 +188,10 @@ typedef struct {
* among existing platforms.
*/
-static const LocaleTable localeTable[] = {
- {"", "iso8859-1"},
- {"ansi-1251", "cp1251"},
- {"ansi_x3.4-1968", "iso8859-1"},
+static CONST LocaleTable localeTable[] = {
+ {"", "iso8859-1"},
+ {"ansi-1251", "cp1251"},
+ {"ansi_x3.4-1968", "iso8859-1"},
{"ascii", "ascii"},
{"big5", "big5"},
{"cp1250", "cp1250"},
@@ -172,61 +228,61 @@ static const LocaleTable localeTable[] = {
{"euc-cn", "euc-cn"},
{"euc-jp", "euc-jp"},
{"euc-kr", "euc-kr"},
- {"eucjp", "euc-jp"},
- {"euckr", "euc-kr"},
- {"euctw", "euc-cn"},
+ {"eucjp", "euc-jp"},
+ {"euckr", "euc-kr"},
+ {"euctw", "euc-cn"},
{"gb12345", "gb12345"},
{"gb1988", "gb1988"},
{"gb2312", "gb2312"},
- {"gb2312-1980", "gb2312"},
+ {"gb2312-1980", "gb2312"},
{"gb2312-raw", "gb2312-raw"},
- {"greek8", "cp869"},
- {"ibm1250", "cp1250"},
- {"ibm1251", "cp1251"},
- {"ibm1252", "cp1252"},
- {"ibm1253", "cp1253"},
- {"ibm1254", "cp1254"},
- {"ibm1255", "cp1255"},
- {"ibm1256", "cp1256"},
- {"ibm1257", "cp1257"},
- {"ibm1258", "cp1258"},
- {"ibm437", "cp437"},
- {"ibm737", "cp737"},
- {"ibm775", "cp775"},
- {"ibm850", "cp850"},
- {"ibm852", "cp852"},
- {"ibm855", "cp855"},
- {"ibm857", "cp857"},
- {"ibm860", "cp860"},
- {"ibm861", "cp861"},
- {"ibm862", "cp862"},
- {"ibm863", "cp863"},
- {"ibm864", "cp864"},
- {"ibm865", "cp865"},
- {"ibm866", "cp866"},
- {"ibm869", "cp869"},
- {"ibm874", "cp874"},
- {"ibm932", "cp932"},
- {"ibm936", "cp936"},
- {"ibm949", "cp949"},
- {"ibm950", "cp950"},
- {"iso-2022", "iso2022"},
- {"iso-2022-jp", "iso2022-jp"},
- {"iso-2022-kr", "iso2022-kr"},
- {"iso-8859-1", "iso8859-1"},
- {"iso-8859-10", "iso8859-10"},
- {"iso-8859-13", "iso8859-13"},
- {"iso-8859-14", "iso8859-14"},
- {"iso-8859-15", "iso8859-15"},
- {"iso-8859-16", "iso8859-16"},
- {"iso-8859-2", "iso8859-2"},
- {"iso-8859-3", "iso8859-3"},
- {"iso-8859-4", "iso8859-4"},
- {"iso-8859-5", "iso8859-5"},
- {"iso-8859-6", "iso8859-6"},
- {"iso-8859-7", "iso8859-7"},
- {"iso-8859-8", "iso8859-8"},
- {"iso-8859-9", "iso8859-9"},
+ {"greek8", "cp869"},
+ {"ibm1250", "cp1250"},
+ {"ibm1251", "cp1251"},
+ {"ibm1252", "cp1252"},
+ {"ibm1253", "cp1253"},
+ {"ibm1254", "cp1254"},
+ {"ibm1255", "cp1255"},
+ {"ibm1256", "cp1256"},
+ {"ibm1257", "cp1257"},
+ {"ibm1258", "cp1258"},
+ {"ibm437", "cp437"},
+ {"ibm737", "cp737"},
+ {"ibm775", "cp775"},
+ {"ibm850", "cp850"},
+ {"ibm852", "cp852"},
+ {"ibm855", "cp855"},
+ {"ibm857", "cp857"},
+ {"ibm860", "cp860"},
+ {"ibm861", "cp861"},
+ {"ibm862", "cp862"},
+ {"ibm863", "cp863"},
+ {"ibm864", "cp864"},
+ {"ibm865", "cp865"},
+ {"ibm866", "cp866"},
+ {"ibm869", "cp869"},
+ {"ibm874", "cp874"},
+ {"ibm932", "cp932"},
+ {"ibm936", "cp936"},
+ {"ibm949", "cp949"},
+ {"ibm950", "cp950"},
+ {"iso-2022", "iso2022"},
+ {"iso-2022-jp", "iso2022-jp"},
+ {"iso-2022-kr", "iso2022-kr"},
+ {"iso-8859-1", "iso8859-1"},
+ {"iso-8859-10", "iso8859-10"},
+ {"iso-8859-13", "iso8859-13"},
+ {"iso-8859-14", "iso8859-14"},
+ {"iso-8859-15", "iso8859-15"},
+ {"iso-8859-16", "iso8859-16"},
+ {"iso-8859-2", "iso8859-2"},
+ {"iso-8859-3", "iso8859-3"},
+ {"iso-8859-4", "iso8859-4"},
+ {"iso-8859-5", "iso8859-5"},
+ {"iso-8859-6", "iso8859-6"},
+ {"iso-8859-7", "iso8859-7"},
+ {"iso-8859-8", "iso8859-8"},
+ {"iso-8859-9", "iso8859-9"},
{"iso2022", "iso2022"},
{"iso2022-jp", "iso2022-jp"},
{"iso2022-kr", "iso2022-kr"},
@@ -244,47 +300,47 @@ static const LocaleTable localeTable[] = {
{"iso8859-7", "iso8859-7"},
{"iso8859-8", "iso8859-8"},
{"iso8859-9", "iso8859-9"},
- {"iso88591", "iso8859-1"},
- {"iso885915", "iso8859-15"},
- {"iso88592", "iso8859-2"},
- {"iso88595", "iso8859-5"},
- {"iso88596", "iso8859-6"},
- {"iso88597", "iso8859-7"},
- {"iso88598", "iso8859-8"},
- {"iso88599", "iso8859-9"},
+ {"iso88591", "iso8859-1"},
+ {"iso885915", "iso8859-15"},
+ {"iso88592", "iso8859-2"},
+ {"iso88595", "iso8859-5"},
+ {"iso88596", "iso8859-6"},
+ {"iso88597", "iso8859-7"},
+ {"iso88598", "iso8859-8"},
+ {"iso88599", "iso8859-9"},
#ifdef hpux
- {"ja", "shiftjis"},
+ {"ja", "shiftjis"},
#else
- {"ja", "euc-jp"},
+ {"ja", "euc-jp"},
#endif
- {"ja_jp", "euc-jp"},
- {"ja_jp.euc", "euc-jp"},
- {"ja_jp.eucjp", "euc-jp"},
- {"ja_jp.jis", "iso2022-jp"},
- {"ja_jp.mscode", "shiftjis"},
- {"ja_jp.sjis", "shiftjis"},
- {"ja_jp.ujis", "euc-jp"},
- {"japan", "euc-jp"},
+ {"ja_jp", "euc-jp"},
+ {"ja_jp.euc", "euc-jp"},
+ {"ja_jp.eucjp", "euc-jp"},
+ {"ja_jp.jis", "iso2022-jp"},
+ {"ja_jp.mscode", "shiftjis"},
+ {"ja_jp.sjis", "shiftjis"},
+ {"ja_jp.ujis", "euc-jp"},
+ {"japan", "euc-jp"},
#ifdef hpux
- {"japanese", "shiftjis"},
+ {"japanese", "shiftjis"},
#else
- {"japanese", "euc-jp"},
+ {"japanese", "euc-jp"},
#endif
- {"japanese-sjis", "shiftjis"},
- {"japanese-ujis", "euc-jp"},
- {"japanese.euc", "euc-jp"},
- {"japanese.sjis", "shiftjis"},
+ {"japanese-sjis", "shiftjis"},
+ {"japanese-ujis", "euc-jp"},
+ {"japanese.euc", "euc-jp"},
+ {"japanese.sjis", "shiftjis"},
{"jis0201", "jis0201"},
{"jis0208", "jis0208"},
{"jis0212", "jis0212"},
- {"jp_jp", "shiftjis"},
- {"ko", "euc-kr"},
- {"ko_kr", "euc-kr"},
- {"ko_kr.euc", "euc-kr"},
- {"ko_kw.euckw", "euc-kr"},
+ {"jp_jp", "shiftjis"},
+ {"ko", "euc-kr"},
+ {"ko_kr", "euc-kr"},
+ {"ko_kr.euc", "euc-kr"},
+ {"ko_kw.euckw", "euc-kr"},
{"koi8-r", "koi8-r"},
{"koi8-u", "koi8-u"},
- {"korean", "euc-kr"},
+ {"korean", "euc-kr"},
{"ksc5601", "ksc5601"},
{"maccenteuro", "macCentEuro"},
{"maccroatian", "macCroatian"},
@@ -298,32 +354,35 @@ static const LocaleTable localeTable[] = {
{"macthai", "macThai"},
{"macturkish", "macTurkish"},
{"macukraine", "macUkraine"},
- {"roman8", "iso8859-1"},
- {"ru", "iso8859-5"},
- {"ru_ru", "iso8859-5"},
- {"ru_su", "iso8859-5"},
+ {"roman8", "iso8859-1"},
+ {"ru", "iso8859-5"},
+ {"ru_ru", "iso8859-5"},
+ {"ru_su", "iso8859-5"},
{"shiftjis", "shiftjis"},
- {"sjis", "shiftjis"},
+ {"sjis", "shiftjis"},
{"symbol", "symbol"},
{"tis-620", "tis-620"},
- {"tis620", "tis-620"},
- {"turkish8", "cp857"},
- {"utf8", "utf-8"},
- {"zh", "cp936"},
- {"zh_cn.gb2312", "euc-cn"},
- {"zh_cn.gbk", "euc-cn"},
- {"zh_cz.gb2312", "euc-cn"},
- {"zh_tw", "euc-tw"},
- {"zh_tw.big5", "big5"},
+ {"tis620", "tis-620"},
+ {"turkish8", "cp857"},
+ {"utf8", "utf-8"},
+ {"zh", "cp936"},
+ {"zh_cn.gb2312", "euc-cn"},
+ {"zh_cn.gbk", "euc-cn"},
+ {"zh_cz.gb2312", "euc-cn"},
+ {"zh_tw", "euc-tw"},
+ {"zh_tw.big5", "big5"},
};
+#ifndef TCL_NO_STACK_CHECK
+static int GetStackSize(size_t *stackSizePtr);
+#endif /* TCL_NO_STACK_CHECK */
#ifdef HAVE_COREFOUNDATION
static int MacOSXGetLibraryPath(Tcl_Interp *interp,
int maxPathLen, char *tclLibPath);
#endif /* HAVE_COREFOUNDATION */
#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \
- (TCL_THREADS && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
+ (defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
(defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \
(defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\
)))
@@ -342,7 +401,7 @@ long tclMacOSXDarwinRelease = 0;
*
* TclpInitPlatform --
*
- * Initialize all the platform-dependent things like signals and
+ * Initialize all the platform-dependant things like signals and
* floating-point error handling.
*
* Called at process initialization time.
@@ -369,13 +428,13 @@ TclpInitPlatform(void)
* Make sure, that the standard FDs exist. [Bug 772288]
*/
- if (TclOSseek(0, 0, SEEK_CUR) == -1 && errno == EBADF) {
+ if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
open("/dev/null", O_RDONLY);
}
- if (TclOSseek(1, 0, SEEK_CUR) == -1 && errno == EBADF) {
+ if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
open("/dev/null", O_WRONLY);
}
- if (TclOSseek(2, 0, SEEK_CUR) == -1 && errno == EBADF) {
+ if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
open("/dev/null", O_WRONLY);
}
@@ -393,6 +452,14 @@ TclpInitPlatform(void)
#endif /* SIGPIPE */
#if defined(__FreeBSD__) && defined(__GNUC__)
+ /*
+ * Adjust the rounding mode to be more conventional. Note that FreeBSD
+ * only provides the __fpsetreg() used by the following two for the GNU
+ * Compiler. When using, say, Intel's icc they break. (Partially based on
+ * patch in BSD ports system from root@celsius.bychok.com)
+ */
+
+ fpsetround(FP_RN);
(void) fpsetmask(0L);
#endif
@@ -418,7 +485,7 @@ TclpInitPlatform(void)
/*
* In case the initial locale is not "C", ensure that the numeric
* processing is done in "C" locale regardless. This is needed because Tcl
- * relies on routines like strtol/strtoul, but should not have locale dependent
+ * relies on routines like strtod, but should not have locale dependent
* behavior.
*/
@@ -455,31 +522,31 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- unsigned int *lengthPtr,
+ int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
- const char *str;
+ CONST char *str;
Tcl_DString buffer;
- TclNewObj(pathPtr);
+ pathPtr = Tcl_NewObj();
/*
* Look for the library relative to the TCL_LIBRARY env variable. If the
* last dirname in the TCL_LIBRARY path does not match the last dirname in
* the installLib variable, use the last dir name of installLib in
- * addition to the original TCL_LIBRARY path.
+ * addition to the orginal TCL_LIBRARY path.
*/
str = getenv("TCL_LIBRARY"); /* INTL: Native. */
- Tcl_ExternalToUtfDString(NULL, str, TCL_INDEX_NONE, &buffer);
+ Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
str = Tcl_DStringValue(&buffer);
if ((str != NULL) && (str[0] != '\0')) {
Tcl_DString ds;
int pathc;
- const char **pathv;
+ CONST char **pathv;
char installLib[LIBRARY_SIZE];
Tcl_DStringInit(&ds);
@@ -490,13 +557,14 @@ TclpInitLibraryPath(
* installed.
*/
- snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION);
+ sprintf(installLib, "lib/tcl%s", TCL_VERSION);
/*
* If TCL_LIBRARY is set, search there.
*/
- Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, TCL_INDEX_NONE));
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_SplitPath(str, &pathc, &pathv);
if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
@@ -510,9 +578,11 @@ TclpInitLibraryPath(
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
- Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds));
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
}
- ckfree(pathv);
+ ckfree((char *) pathv);
}
/*
@@ -537,17 +607,16 @@ TclpInitLibraryPath(
str = defaultLibraryDir;
}
if (str[0] != '\0') {
- objPtr = Tcl_NewStringObj(str, TCL_INDEX_NONE);
+ objPtr = Tcl_NewStringObj(str, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
}
}
Tcl_DStringFree(&buffer);
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
- str = TclGetString(pathPtr);
- *lengthPtr = pathPtr->length;
- *valuePtr = (char *)ckalloc(*lengthPtr + 1);
- memcpy(*valuePtr, str, *lengthPtr + 1);
+ str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
+ *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
+ memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
Tcl_DecrRefCount(pathPtr);
}
@@ -584,14 +653,20 @@ TclpSetInitialEncodings(void)
Tcl_DStringFree(&encodingName);
}
-static const char *
+void
+TclpSetInterfaces(void)
+{
+ /* do nothing */
+}
+
+static CONST char *
SearchKnownEncodings(
- const char *encoding)
+ CONST char *encoding)
{
int left = 0;
int right = sizeof(localeTable)/sizeof(LocaleTable);
- while (left < right) {
+ while (left <= right) {
int test = (left + right)/2;
int code = strcmp(localeTable[test].lang, encoding);
@@ -607,12 +682,12 @@ SearchKnownEncodings(
return NULL;
}
-const char *
+CONST char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
- const char *encoding;
- const char *knownEncoding;
+ CONST char *encoding;
+ CONST char *knownEncoding;
Tcl_DStringInit(bufPtr);
@@ -635,13 +710,13 @@ Tcl_GetEncodingNameFromEnvironment(
*/
Tcl_DStringInit(&ds);
- encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), TCL_INDEX_NONE);
+ encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);
Tcl_UtfToLower(Tcl_DStringValue(&ds));
knownEncoding = SearchKnownEncodings(encoding);
if (knownEncoding != NULL) {
- Tcl_DStringAppend(bufPtr, knownEncoding, TCL_INDEX_NONE);
+ Tcl_DStringAppend(bufPtr, knownEncoding, -1);
} else if (NULL != Tcl_GetEncoding(NULL, encoding)) {
- Tcl_DStringAppend(bufPtr, encoding, TCL_INDEX_NONE);
+ Tcl_DStringAppend(bufPtr, encoding, -1);
}
Tcl_DStringFree(&ds);
if (Tcl_DStringLength(bufPtr)) {
@@ -668,19 +743,19 @@ Tcl_GetEncodingNameFromEnvironment(
}
if (encoding != NULL) {
- const char *p;
+ CONST char *p;
Tcl_DString ds;
Tcl_DStringInit(&ds);
p = encoding;
- encoding = Tcl_DStringAppend(&ds, p, TCL_INDEX_NONE);
+ encoding = Tcl_DStringAppend(&ds, p, -1);
Tcl_UtfToLower(Tcl_DStringValue(&ds));
knownEncoding = SearchKnownEncodings(encoding);
if (knownEncoding != NULL) {
- Tcl_DStringAppend(bufPtr, knownEncoding, TCL_INDEX_NONE);
+ Tcl_DStringAppend(bufPtr, knownEncoding, -1);
} else if (NULL != Tcl_GetEncoding(NULL, encoding)) {
- Tcl_DStringAppend(bufPtr, encoding, TCL_INDEX_NONE);
+ Tcl_DStringAppend(bufPtr, encoding, -1);
}
if (Tcl_DStringLength(bufPtr)) {
Tcl_DStringFree(&ds);
@@ -701,9 +776,9 @@ Tcl_GetEncodingNameFromEnvironment(
if (*p != '\0') {
knownEncoding = SearchKnownEncodings(p);
if (knownEncoding != NULL) {
- Tcl_DStringAppend(bufPtr, knownEncoding, TCL_INDEX_NONE);
+ Tcl_DStringAppend(bufPtr, knownEncoding, -1);
} else if (NULL != Tcl_GetEncoding(NULL, p)) {
- Tcl_DStringAppend(bufPtr, p, TCL_INDEX_NONE);
+ Tcl_DStringAppend(bufPtr, p, -1);
}
}
Tcl_DStringFree(&ds);
@@ -711,7 +786,7 @@ Tcl_GetEncodingNameFromEnvironment(
return Tcl_DStringValue(bufPtr);
}
}
- return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, TCL_INDEX_NONE);
+ return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1);
}
/*
@@ -733,43 +808,6 @@ Tcl_GetEncodingNameFromEnvironment(
*----------------------------------------------------------------------
*/
-#if defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020
-/*
- * Helper because whether CFLocaleCopyCurrent and CFLocaleGetIdentifier are
- * strongly or weakly bound varies by version of OSX, triggering warnings.
- */
-
-static inline void
-InitMacLocaleInfoVar(
- CFLocaleRef (*localeCopyCurrent)(void),
- CFStringRef (*localeGetIdentifier)(CFLocaleRef),
- Tcl_Interp *interp)
-{
- CFLocaleRef localeRef;
- CFStringRef locale;
- char loc[256];
-
- if (localeCopyCurrent == NULL || localeGetIdentifier == NULL) {
- return;
- }
-
- localeRef = localeCopyCurrent();
- if (!localeRef) {
- return;
- }
-
- locale = localeGetIdentifier(localeRef);
- if (locale && CFStringGetCString(locale, loc, 256,
- kCFStringEncodingUTF8)) {
- if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
- Tcl_ResetResult(interp);
- }
- Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
- }
- CFRelease(localeRef);
-}
-#endif /*defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020*/
-
void
TclpSetVariables(
Tcl_Interp *interp)
@@ -783,37 +821,62 @@ TclpSetVariables(
struct utsname name;
#endif
int unameOK;
- const char *p, *q;
- Tcl_Obj *pkgListObj = Tcl_NewObj();
+ Tcl_DString ds;
#ifdef HAVE_COREFOUNDATION
char tclLibPath[MAXPATHLEN + 1];
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
/*
* Set msgcat fallback locale to current CFLocale identifier.
*/
-#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
- InitMacLocaleInfoVar(CFLocaleCopyCurrent, CFLocaleGetIdentifier, interp);
+ CFLocaleRef localeRef;
+
+ if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL &&
+ (localeRef = CFLocaleCopyCurrent())) {
+ CFStringRef locale = CFLocaleGetIdentifier(localeRef);
+
+ if (locale) {
+ char loc[256];
+
+ if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
+ if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
+ Tcl_ResetResult(interp);
+ }
+ Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
+ }
+ }
+ CFRelease(localeRef);
+ }
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */
if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
- const char *str;
+ CONST char *str;
CFBundleRef bundleRef;
- Tcl_DString ds;
- Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(tclLibPath, -1));
+ Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+
str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
if ((str != NULL) && (str[0] != '\0')) {
- p = Tcl_DStringValue(&ds);
- while ((q = strchr(p, ':')) != NULL) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
- p = q+1;
- }
- if (*p) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
- }
+ char *p = Tcl_DStringValue(&ds);
+
+ /*
+ * Convert DYLD_FRAMEWORK_PATH from colon to space separated.
+ */
+
+ do {
+ if (*p == ':') {
+ *p = ' ';
+ }
+ } while (*p++);
+ Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_DStringFree(&ds);
}
bundleRef = CFBundleGetMainBundle();
@@ -827,7 +890,10 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(tclLibPath, -1));
+ Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
@@ -837,22 +903,21 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(tclLibPath, -1));
+ Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
}
- }
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+ } else
#endif /* HAVE_COREFOUNDATION */
- p = pkgPath;
- while ((q = strchr(p, ':')) != NULL) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
- p = q+1;
- }
- if (*p) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
+ {
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
}
- Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY);
#ifdef DJGPP
Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
@@ -864,23 +929,26 @@ TclpSetVariables(
#ifdef __CYGWIN__
unameOK = 1;
if (!osInfoInitialized) {
- void *handle = GetModuleHandleW(L"NTDLL");
+ 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(&sysInfo);
- if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) {
- osInfo.dwMajorVersion = 11;
+ if (osInfo.dwPlatformId < NUMPLATFORMS) {
+ Tcl_SetVar2(interp, "tcl_platform", "os",
+ platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
}
- Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
- snprintf(buffer, sizeof(buffer), "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
+ sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
@@ -890,12 +958,11 @@ TclpSetVariables(
#elif !defined NO_UNAME
if (uname(&name) >= 0) {
- const char *native;
- Tcl_DString ds;
+ CONST char *native;
unameOK = 1;
- native = Tcl_ExternalToUtfDString(NULL, name.sysname, TCL_INDEX_NONE, &ds);
+ native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
@@ -953,24 +1020,17 @@ TclpSetVariables(
{
struct passwd *pwEnt = TclpGetPwUid(getuid());
const char *user;
- Tcl_DString ds;
if (pwEnt == NULL) {
user = "";
Tcl_DStringInit(&ds); /* ensure cleanliness */
} else {
- user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, TCL_INDEX_NONE, &ds);
+ user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds);
}
Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
}
-
- /*
- * Define what the platform PATH separator is. [TIP #315]
- */
-
- Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ":", TCL_GLOBAL_ONLY);
}
/*
@@ -979,7 +1039,7 @@ TclpSetVariables(
* TclpFindVariable --
*
* Locate the entry in environ for a given name. On Unix this routine is
- * case sensitive, on Windows this matches mixed case.
+ * case sensetive, on Windows this matches mixed case.
*
* Results:
* The return value is the index in environ of an entry with the name
@@ -995,7 +1055,7 @@ TclpSetVariables(
int
TclpFindVariable(
- const char *name, /* Name of desired environment variable
+ CONST char *name, /* Name of desired environment variable
* (native). */
int *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
@@ -1003,12 +1063,12 @@ TclpFindVariable(
* searches). */
{
int i, result = -1;
- const char *env, *p1, *p2;
+ register CONST char *env, *p1, *p2;
Tcl_DString envString;
Tcl_DStringInit(&envString);
for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
- p1 = Tcl_ExternalToUtfDString(NULL, env, TCL_INDEX_NONE, &envString);
+ p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
p2 = name;
for (; *p2 == *p1; p1++, p2++) {
@@ -1030,6 +1090,216 @@ TclpFindVariable(
return result;
}
+#ifndef TCL_NO_STACK_CHECK
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetCStackParams --
+ *
+ * Determine the stack params for the current thread: in which
+ * direction does the stack grow, and what is the stack lower (resp.
+ * upper) bound for safe invocation of a new command? This is used to
+ * cache the values needed for an efficient computation of
+ * TclpCheckStackSpace() when the interp is known.
+ *
+ * Results:
+ * Returns 1 if the stack grows down, in which case a stack lower bound
+ * is stored at stackBoundPtr. If the stack grows up, 0 is returned and
+ * an upper bound is stored at stackBoundPtr. If a bound cannot be
+ * determined NULL is stored at stackBoundPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetCStackParams(
+ int **stackBoundPtr)
+{
+ int result = TCL_OK;
+ size_t stackSize = 0; /* The size of the current stack. */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ /* Most variables are actually in a
+ * thread-specific data block to minimise the
+ * impact on the stack. */
+#ifdef TCL_CROSS_COMPILE
+ if (stackGrowsDown == -1) {
+ /*
+ * Not initialised!
+ */
+
+ stackGrowsDown = StackGrowsDown(NULL);
+ }
+#endif
+
+ /*
+ * The first time through in a thread: record the "outermost" stack
+ * frame and inquire with the OS about the stack size.
+ */
+
+ if (tsdPtr->outerVarPtr == NULL) {
+ tsdPtr->outerVarPtr = &result;
+ result = GetStackSize(&stackSize);
+ if (result != TCL_OK) {
+ /* Can't check, assume it always succeeds */
+#ifdef TCL_CROSS_COMPILE
+ stackGrowsDown = 1;
+#endif
+ tsdPtr->stackBound = NULL;
+ goto done;
+ }
+ }
+
+ if (stackSize || (tsdPtr->stackBound &&
+ ((stackGrowsDown && (&result < tsdPtr->stackBound)) ||
+ (!stackGrowsDown && (&result > tsdPtr->stackBound))))) {
+ /*
+ * Either the thread's first pass or stack failure: set the params
+ */
+
+ if (!stackSize) {
+ /*
+ * Stack failure: if we didn't already blow up, we are within the
+ * safety area. Recheck with the OS in case the stack was grown.
+ */
+ result = GetStackSize(&stackSize);
+ if (result != TCL_OK) {
+ /* Can't check, assume it always succeeds */
+#ifdef TCL_CROSS_COMPILE
+ stackGrowsDown = 1;
+#endif
+ tsdPtr->stackBound = NULL;
+ goto done;
+ }
+ }
+
+ if (stackGrowsDown) {
+ tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr -
+ stackSize);
+ if (tsdPtr->stackBound > tsdPtr->outerVarPtr) {
+ /* Overflow, that should never happen, just set it to NULL.
+ * See [Bug #3166410] */
+ tsdPtr->stackBound = NULL;
+ }
+ } else {
+ tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr +
+ stackSize);
+ if (tsdPtr->stackBound < tsdPtr->outerVarPtr) {
+ /* Overflow, that should never happen, just set it to NULL.
+ * See [Bug #3166410] */
+ tsdPtr->stackBound = NULL;
+ }
+ }
+ }
+
+ done:
+ *stackBoundPtr = tsdPtr->stackBound;
+ return stackGrowsDown;
+}
+
+#ifdef TCL_CROSS_COMPILE
+int
+StackGrowsDown(
+ int *parent)
+{
+ int here;
+ if (!parent) {
+ return StackGrowsDown(&here);
+ }
+ return (&here < parent);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStackSize --
+ *
+ * Discover what the stack size for the current thread/process actually
+ * is. Expects to only ever be called once per thread and then only at a
+ * point when there is a reasonable amount of space left on the current
+ * stack; TclpCheckStackSpace is called sufficiently frequently that that
+ * is true.
+ *
+ * Results:
+ * TCL_OK if the stack space was discovered, TCL_BREAK if the stack space
+ * was undiscoverable in a way that stack checks should fail, and
+ * TCL_CONTINUE if the stack space was undiscoverable in a way that stack
+ * checks should succeed.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetStackSize(
+ size_t *stackSizePtr)
+{
+ size_t rawStackSize;
+ struct rlimit rLimit; /* The result from getrlimit(). */
+
+#ifdef TCL_THREADS
+ rawStackSize = TclpThreadGetStackSize();
+ if (rawStackSize == (size_t) -1) {
+ /*
+ * Some kind of confirmed error in TclpThreadGetStackSize?! Fall back
+ * to whatever getrlimit can determine.
+ */
+ STACK_DEBUG(("stack checks: TclpThreadGetStackSize failed in \n"));
+ }
+ if (rawStackSize > 0) {
+ goto finalSanityCheck;
+ }
+
+ /*
+ * If we have zero or an error, try the system limits instead. After all,
+ * the pthread documentation states that threads should always be bound by
+ * the system stack size limit in any case.
+ */
+#endif /* TCL_THREADS */
+
+ if (getrlimit(RLIMIT_STACK, &rLimit) != 0) {
+ /*
+ * getrlimit() failed, just fail the whole thing.
+ */
+ STACK_DEBUG(("skipping stack checks with failure: getrlimit failed\n"));
+ return TCL_BREAK;
+ }
+ if (rLimit.rlim_cur == RLIM_INFINITY) {
+ /*
+ * Limit is "infinite"; there is no stack limit.
+ */
+ STACK_DEBUG(("skipping stack checks with success: infinite limit\n"));
+ return TCL_CONTINUE;
+ }
+ rawStackSize = rLimit.rlim_cur;
+
+ /*
+ * Final sanity check on the determined stack size. If we fail this,
+ * assume there are bogus values about and that we can't actually figure
+ * out what the stack size really is.
+ */
+
+#ifdef TCL_THREADS /* Stop warning... */
+ finalSanityCheck:
+#endif
+ if (rawStackSize <= 0) {
+ STACK_DEBUG(("skipping stack checks with success\n"));
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * Calculate a stack size with a safety margin.
+ */
+
+ *stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR)
+ - (getpagesize() * TCL_RESERVED_STACK_PAGES);
+
+ return TCL_OK;
+}
+#endif /* TCL_NO_STACK_CHECK */
+
/*
*----------------------------------------------------------------------
*
@@ -1048,27 +1318,22 @@ TclpFindVariable(
*/
#ifdef HAVE_COREFOUNDATION
-#ifdef TCL_FRAMEWORK
static int
MacOSXGetLibraryPath(
Tcl_Interp *interp,
int maxPathLen,
char *tclLibPath)
{
- return Tcl_MacOSXOpenVersionedBundleResources(interp,
+ int foundInFramework = TCL_ERROR;
+
+#ifdef TCL_FRAMEWORK
+ foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp,
"com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen,
tclLibPath);
-}
-#else
-static int
-MacOSXGetLibraryPath(
- TCL_UNUSED(Tcl_Interp *),
- TCL_UNUSED(int),
- TCL_UNUSED(char *))
-{
- return TCL_ERROR;
-}
#endif
+
+ return foundInFramework;
+}
#endif /* HAVE_COREFOUNDATION */
/*
generated by cgit v0.12 at 2025-12-20 09:30:06 (GMT)