summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixInit.c')
-rw-r--r--unix/tclUnixInit.c551
1 files changed, 219 insertions, 332 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 71bd1bb..1e35b92 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -6,15 +6,20 @@
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
- *
- * RCS: @(#) $Id: tclUnixInit.c,v 1.63 2006/02/08 21:41:28 dgp Exp $
*/
#include "tclInt.h"
#include <stddef.h>
#include <locale.h>
#ifdef HAVE_LANGINFO
-#include <langinfo.h>
+# include <langinfo.h>
+# ifdef __APPLE__
+# 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
+ extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE;
+# endif
+# endif
#endif
#include <sys/resource.h>
#if defined(__FreeBSD__) && defined(__GNUC__)
@@ -26,73 +31,59 @@
# include <dlfcn.h>
# endif
#endif
-#ifdef HAVE_COREFOUNDATION
-#include <CoreFoundation/CoreFoundation.h>
-#endif
-
-/*
- * Define this if you want to revert to the old behavior of never checking the
- * stack.
- */
-
-#undef TCL_NO_STACK_CHECK
-/*
- * Define this if you want to see a lot of output regarding stack checking.
- */
+#ifdef __CYGWIN__
+DLLIMPORT extern __stdcall unsigned char GetVersionExW(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 *);
-#undef TCL_DEBUG_STACK_CHECK
+#define NUMPLATFORMS 4
+static const char *const platforms[NUMPLATFORMS] = {
+ "Win32s", "Windows 95", "Windows NT", "Windows CE"
+};
-/*
- * Values used to compute how much space is really available for Tcl's use for
- * the stack.
- *
- * NOTE: Now I have some idea why the maximum stack size must be divided by 64
- * on FreeBSD with threads enabled to get a reasonably correct value.
- *
- * The getrlimit() function is documented to return the maximum stack size in
- * bytes. However, with threads enabled, the pthread library does bad things
- * to the stack size limits. First, the limits cannot be changed. Second, they
- * appear to be reported incorrectly by a factor of about 64.
- *
- * The defines below may need to be adjusted if more platforms have this
- * broken behavior with threads enabled.
- */
+#define NUMPROCESSORS 11
+static const char *const processors[NUMPROCESSORS] = {
+ "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
+ "amd64", "ia32_on_win64"
+};
-#if defined(__FreeBSD__)
-# define TCL_MAGIC_STACK_DIVISOR 64
-# define TCL_RESERVED_STACK_PAGES 3
+typedef struct _SYSTEM_INFO {
+ union {
+ DWORD dwOemId;
+ struct {
+ int wProcessorArchitecture;
+ int wReserved;
+ };
+ };
+ DWORD dwPageSize;
+ void *lpMinimumApplicationAddress;
+ void *lpMaximumApplicationAddress;
+ void *dwActiveProcessorMask;
+ DWORD dwNumberOfProcessors;
+ DWORD dwProcessorType;
+ DWORD dwAllocationGranularity;
+ int wProcessorLevel;
+ int wProcessorRevision;
+} SYSTEM_INFO;
+
+typedef struct _OSVERSIONINFOW {
+ DWORD dwOSVersionInfoSize;
+ DWORD dwMajorVersion;
+ DWORD dwMinorVersion;
+ DWORD dwBuildNumber;
+ DWORD dwPlatformId;
+ wchar_t szCSDVersion[128];
+} OSVERSIONINFOW;
#endif
-#ifndef TCL_MAGIC_STACK_DIVISOR
-#define TCL_MAGIC_STACK_DIVISOR 1
-#endif
-#ifndef TCL_RESERVED_STACK_PAGES
-#define TCL_RESERVED_STACK_PAGES 8
+#ifdef HAVE_COREFOUNDATION
+#include <CoreFoundation/CoreFoundation.h>
#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 initialised; /* Have we found what the stack size was? */
- int stackDetermineResult; /* What happened when we did that? */
- size_t stackSize; /* The size of the current stack. */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-#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.
@@ -124,9 +115,9 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
* first list checked for a mapping from env encoding to Tcl encoding name.
*/
-typedef struct LocaleTable {
- CONST char *lang;
- CONST char *encoding;
+typedef struct {
+ const char *lang;
+ const char *encoding;
} LocaleTable;
/*
@@ -139,7 +130,7 @@ typedef struct LocaleTable {
* among existing platforms.
*/
-static CONST LocaleTable localeTable[] = {
+static const LocaleTable localeTable[] = {
{"", "iso8859-1"},
{"ansi-1251", "cp1251"},
{"ansi_x3.4-1968", "iso8859-1"},
@@ -324,13 +315,25 @@ static CONST LocaleTable localeTable[] = {
{"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) && ( \
+ (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)\
+ )))
+/*
+ * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
+ * initialize release global at startup from uname().
+ */
+#define GET_DARWIN_RELEASE 1
+MODULE_SCOPE long tclMacOSXDarwinRelease;
+long tclMacOSXDarwinRelease = 0;
+#endif
+
/*
*---------------------------------------------------------------------------
@@ -388,14 +391,6 @@ 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
@@ -403,7 +398,8 @@ TclpInitPlatform(void)
/*
* Find local symbols. Don't report an error if we fail.
*/
- (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */
+
+ (void) dlopen(NULL, RTLD_NOW); /* INTL: Native. */
#endif
/*
@@ -425,6 +421,16 @@ TclpInitPlatform(void)
*/
setlocale(LC_NUMERIC, "C");
+
+#ifdef GET_DARWIN_RELEASE
+ {
+ struct utsname name;
+
+ if (!uname(&name)) {
+ tclMacOSXDarwinRelease = strtol(name.release, NULL, 10);
+ }
+ }
+#endif
}
/*
@@ -447,29 +453,17 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- int *lengthPtr,
+ size_t *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
- CONST char *str;
- Tcl_DString buffer, ds;
- int pathc;
- CONST char **pathv;
- char installLib[LIBRARY_SIZE];
+ const char *str;
+ Tcl_DString buffer;
- Tcl_DStringInit(&ds);
pathPtr = Tcl_NewObj();
/*
- * Initialize the substrings used when locating an executable. The
- * installLib variable computes the path as though the executable is
- * installed.
- */
-
- sprintf(installLib, "lib/tcl%s", TCL_VERSION);
-
- /*
* 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
@@ -481,12 +475,26 @@ TclpInitLibraryPath(
str = Tcl_DStringValue(&buffer);
if ((str != NULL) && (str[0] != '\0')) {
+ Tcl_DString ds;
+ int pathc;
+ const char **pathv;
+ char installLib[LIBRARY_SIZE];
+
+ Tcl_DStringInit(&ds);
+
+ /*
+ * Initialize the substrings used when locating an executable. The
+ * installLib variable computes the path as though the executable is
+ * installed.
+ */
+
+ sprintf(installLib, "lib/tcl%s", TCL_VERSION);
+
/*
* If TCL_LIBRARY is set, search there.
*/
- objPtr = Tcl_NewStringObj(str, -1);
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1));
Tcl_SplitPath(str, &pathc, &pathv);
if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
@@ -500,17 +508,15 @@ TclpInitLibraryPath(
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
- objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
+ Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
}
- ckfree((char *) pathv);
+ ckfree(pathv);
}
/*
* Finally, look for the library relative to the compiled-in path. This is
* needed when users install Tcl with an exec-prefix that is different
- * from the prtefix.
+ * from the prefix.
*/
{
@@ -536,9 +542,10 @@ TclpInitLibraryPath(
Tcl_DStringFree(&buffer);
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
- str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
- memcpy((VOID *) *valuePtr, (VOID *) str, (size_t)(*lengthPtr)+1);
+ str = TclGetString(pathPtr);
+ *lengthPtr = pathPtr->length;
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, str, *lengthPtr + 1);
Tcl_DecrRefCount(pathPtr);
}
@@ -581,14 +588,14 @@ TclpSetInterfaces(void)
/* do nothing */
}
-static CONST char *
+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);
@@ -604,12 +611,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);
@@ -620,7 +627,11 @@ Tcl_GetEncodingNameFromEnvironment(
*/
#ifdef HAVE_LANGINFO
- if (setlocale(LC_CTYPE, "") != NULL) {
+ if (
+#ifdef WEAK_IMPORT_NL_LANGINFO
+ nl_langinfo != NULL &&
+#endif
+ setlocale(LC_CTYPE, "") != NULL) {
Tcl_DString ds;
/*
@@ -661,7 +672,7 @@ Tcl_GetEncodingNameFromEnvironment(
}
if (encoding != NULL) {
- CONST char *p;
+ const char *p;
Tcl_DString ds;
Tcl_DStringInit(&ds);
@@ -730,24 +741,52 @@ void
TclpSetVariables(
Tcl_Interp *interp)
{
-#ifndef NO_UNAME
+#ifdef __CYGWIN__
+ SYSTEM_INFO sysInfo;
+ static OSVERSIONINFOW osInfo;
+ static int osInfoInitialized = 0;
+ char buffer[TCL_INTEGER_SPACE * 2];
+#elif !defined(NO_UNAME)
struct utsname name;
#endif
int unameOK;
- CONST char *user;
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.
+ */
+
+ 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_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
+ }
+ }
+ CFRelease(localeRef);
+ }
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */
+
if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
- CONST char *str;
- Tcl_DString ds;
+ const char *str;
CFBundleRef bundleRef;
- Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
@@ -763,9 +802,9 @@ TclpSetVariables(
*p = ' ';
}
} while (*p++);
- Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_DStringFree(&ds);
}
@@ -780,9 +819,9 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
@@ -793,20 +832,20 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
}
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
} else
#endif /* HAVE_COREFOUNDATION */
{
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY);
}
#ifdef DJGPP
@@ -816,9 +855,39 @@ TclpSetVariables(
#endif
unameOK = 0;
-#ifndef NO_UNAME
+#ifdef __CYGWIN__
+ unameOK = 1;
+ 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(&sysInfo);
+
+ if (osInfo.dwPlatformId < NUMPLATFORMS) {
+ Tcl_SetVar2(interp, "tcl_platform", "os",
+ platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
+ }
+ 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",
+ processors[sysInfo.wProcessorArchitecture],
+ TCL_GLOBAL_ONLY);
+ }
+
+#elif !defined NO_UNAME
if (uname(&name) >= 0) {
- CONST char *native;
+ const char *native;
unameOK = 1;
@@ -860,12 +929,12 @@ TclpSetVariables(
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
-#endif
+#endif /* DJGPP */
}
Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
TCL_GLOBAL_ONLY);
}
-#endif
+#endif /* !NO_UNAME */
if (!unameOK) {
Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
@@ -873,19 +942,30 @@ TclpSetVariables(
}
/*
- * Copy USER or LOGNAME environment variable into tcl_platform(user).
+ * Copy the username of the real user (according to getuid()) into
+ * tcl_platform(user).
*/
- Tcl_DStringInit(&ds);
- user = TclGetEnv("USER", &ds);
- if (user == NULL) {
- user = TclGetEnv("LOGNAME", &ds);
- if (user == NULL) {
+ {
+ struct passwd *pwEnt = TclpGetPwUid(getuid());
+ const char *user;
+
+ if (pwEnt == NULL) {
user = "";
+ Tcl_DStringInit(&ds); /* ensure cleanliness */
+ } else {
+ user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds);
}
+
+ Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&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);
}
/*
@@ -910,7 +990,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
@@ -918,7 +998,7 @@ TclpFindVariable(
* searches). */
{
int i, result = -1;
- register CONST char *env, *p1, *p2;
+ register const char *env, *p1, *p2;
Tcl_DString envString;
Tcl_DStringInit(&envString);
@@ -945,199 +1025,6 @@ TclpFindVariable(
return result;
}
-/*
- *----------------------------------------------------------------------
- *
- * TclpCheckStackSpace --
- *
- * Detect if we are about to blow the stack. Called before an evaluation
- * can happen when nesting depth is checked.
- *
- * Results:
- * 1 if there is enough stack space to continue; 0 if not.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpCheckStackSpace(void)
-{
-#ifdef TCL_NO_STACK_CHECK
-
- /*
- * This function was normally unimplemented on Unix platforms and this
- * implements old behavior, i.e. no stack checking performed.
- */
-
- return 1;
-
-#else
-
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- /* Most variables are actually in a
- * thread-specific data block to minimise the
- * impact on the stack. */
- register ptrdiff_t stackUsed;
- int localVar; /* Reference to somewhere on the local stack.
- * This is declared last so it's as "deep" as
- * possible. */
-
- if (tsdPtr == NULL) {
- /*
- * This should probably be a panic(); if we're out of stack, we might
- * have virtually no room to manoeuver at all.
- */
-
- Tcl_Panic("failed to get thread specific stack check data");
- }
-
- /*
- * The first time through, we record the "outermost" stack frame.
- */
-
- if (tsdPtr->outerVarPtr == NULL) {
- tsdPtr->outerVarPtr = &localVar;
- }
-
- if (tsdPtr->initialised == 0) {
- /*
- * We appear to have not computed the stack size before. Attempt to
- * retrieve it from either the current thread or, failing that, the
- * process accounting limit. Note that we assume that stack sizes do
- * not change throughout the lifespan of the thread/process; this is
- * almost always true.
- */
-
- tsdPtr->stackDetermineResult = GetStackSize(&tsdPtr->stackSize);
- tsdPtr->initialised = 1;
- }
-
- switch (tsdPtr->stackDetermineResult) {
- case TCL_BREAK:
- STACK_DEBUG(("skipping stack check with failure\n"));
- return 0;
- case TCL_CONTINUE:
- STACK_DEBUG(("skipping stack check with success\n"));
- return 1;
- }
-
- /*
- * Sanity check to see if somehow the stack started going the
- * other way.
- */
-
- if (&localVar > tsdPtr->outerVarPtr) {
- stackUsed = (char *)&localVar - (char *)tsdPtr->outerVarPtr;
- } else {
- stackUsed = (char *)tsdPtr->outerVarPtr - (char *)&localVar;
- }
-
- /*
- * Now we perform the actual check. Are we about to blow our stack frame?
- */
-
- if (stackUsed < (ptrdiff_t) tsdPtr->stackSize) {
- STACK_DEBUG(("stack OK\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
- &localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
- return 1;
- } else {
- STACK_DEBUG(("stack OVERFLOW\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
- &localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
- return 0;
- }
-#endif /* TCL_NO_STACK_CHECK */
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_STACK_CHECK
-static int
-GetStackSize(
- size_t *stackSizePtr)
-{
- size_t rawStackSize;
- struct rlimit rLimit; /* The result from getrlimit(). */
-
-#ifdef TCL_THREADS
- rawStackSize = (size_t) TclpThreadGetStackSize();
- if (rawStackSize == (size_t) -1) {
- /*
- * Some kind of confirmed error?!
- */
- return TCL_BREAK;
- }
- 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.
- */
- return TCL_BREAK;
- }
- if (rLimit.rlim_cur == RLIM_INFINITY) {
- /*
- * Limit is "infinite"; there is no stack limit.
- */
- 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) {
- 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 */
/*
*----------------------------------------------------------------------
generated by cgit v0.12 at 2025-10-31 21:45:25 (GMT)