summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixInit.c')
-rw-r--r--unix/tclUnixInit.c364
1 files changed, 319 insertions, 45 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 1e35b92..a873f6e 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -16,7 +16,7 @@
# 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
+# define WEAK_IMPORT_NL_LANGINFO
extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE;
# endif
# endif
@@ -84,6 +84,64 @@ typedef struct _OSVERSIONINFOW {
#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.
@@ -115,9 +173,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 {
- const char *lang;
- const char *encoding;
+typedef struct LocaleTable {
+ CONST char *lang;
+ CONST char *encoding;
} LocaleTable;
/*
@@ -130,7 +188,7 @@ typedef struct {
* among existing platforms.
*/
-static const LocaleTable localeTable[] = {
+static CONST LocaleTable localeTable[] = {
{"", "iso8859-1"},
{"ansi-1251", "cp1251"},
{"ansi_x3.4-1968", "iso8859-1"},
@@ -315,6 +373,9 @@ 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);
@@ -391,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
@@ -453,12 +522,12 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- size_t *lengthPtr,
+ int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
- const char *str;
+ CONST char *str;
Tcl_DString buffer;
pathPtr = Tcl_NewObj();
@@ -477,7 +546,7 @@ TclpInitLibraryPath(
if ((str != NULL) && (str[0] != '\0')) {
Tcl_DString ds;
int pathc;
- const char **pathv;
+ CONST char **pathv;
char installLib[LIBRARY_SIZE];
Tcl_DStringInit(&ds);
@@ -494,7 +563,8 @@ TclpInitLibraryPath(
* If TCL_LIBRARY is set, search there.
*/
- Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1));
+ 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)) {
@@ -508,9 +578,11 @@ TclpInitLibraryPath(
pathv[pathc - 1] = installLib + 4;
str = Tcl_JoinPath(pathc, pathv, &ds);
- Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
}
- ckfree(pathv);
+ ckfree((char *) pathv);
}
/*
@@ -542,10 +614,9 @@ TclpInitLibraryPath(
Tcl_DStringFree(&buffer);
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
- str = TclGetString(pathPtr);
- *lengthPtr = pathPtr->length;
- *valuePtr = 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);
}
@@ -588,14 +659,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);
@@ -611,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);
@@ -672,7 +743,7 @@ Tcl_GetEncodingNameFromEnvironment(
}
if (encoding != NULL) {
- const char *p;
+ CONST char *p;
Tcl_DString ds;
Tcl_DStringInit(&ds);
@@ -761,7 +832,7 @@ TclpSetVariables(
*/
CFLocaleRef localeRef;
-
+
if (&CFLocaleCopyCurrent != NULL && &CFLocaleGetIdentifier != NULL &&
(localeRef = CFLocaleCopyCurrent())) {
CFStringRef locale = CFLocaleGetIdentifier(localeRef);
@@ -773,7 +844,7 @@ TclpSetVariables(
if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
Tcl_ResetResult(interp);
}
- Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
}
}
CFRelease(localeRef);
@@ -781,12 +852,12 @@ TclpSetVariables(
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */
if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
- const char *str;
+ CONST char *str;
CFBundleRef bundleRef;
- 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_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);
@@ -802,9 +873,9 @@ TclpSetVariables(
*p = ' ';
}
} while (*p++);
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds),
+ Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_DStringFree(&ds);
}
@@ -819,9 +890,9 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
+ Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
@@ -832,20 +903,20 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
+ Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
}
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath,
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
} else
#endif /* HAVE_COREFOUNDATION */
{
- Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
}
#ifdef DJGPP
@@ -887,7 +958,7 @@ TclpSetVariables(
#elif !defined NO_UNAME
if (uname(&name) >= 0) {
- const char *native;
+ CONST char *native;
unameOK = 1;
@@ -960,12 +1031,6 @@ TclpSetVariables(
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);
}
/*
@@ -990,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
@@ -998,7 +1063,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);
@@ -1025,6 +1090,215 @@ 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 */
/*
*----------------------------------------------------------------------
generated by cgit v0.12 at 2024-07-01 07:02:48 (GMT)