diff options
Diffstat (limited to 'unix/tclUnixInit.c')
| -rw-r--r-- | unix/tclUnixInit.c | 316 |
1 files changed, 290 insertions, 26 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index f07b123..f9015b7 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 @@ -81,6 +81,64 @@ typedef struct _OSVERSIONINFOA { #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. @@ -113,8 +171,8 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; */ typedef struct LocaleTable { - const char *lang; - const char *encoding; + CONST char *lang; + CONST char *encoding; } LocaleTable; /* @@ -127,7 +185,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"}, @@ -312,6 +370,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); @@ -463,7 +524,7 @@ TclpInitLibraryPath( { #define LIBRARY_SIZE 32 Tcl_Obj *pathPtr, *objPtr; - const char *str; + CONST char *str; Tcl_DString buffer; pathPtr = Tcl_NewObj(); @@ -482,7 +543,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); @@ -499,7 +560,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)) { @@ -513,9 +575,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); } /* @@ -548,7 +612,7 @@ TclpInitLibraryPath( *encodingPtr = Tcl_GetEncoding(NULL, NULL); str = Tcl_GetStringFromObj(pathPtr, lengthPtr); - *valuePtr = ckalloc((*lengthPtr) + 1); + *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -592,9 +656,9 @@ 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); @@ -615,12 +679,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); @@ -676,7 +740,7 @@ Tcl_GetEncodingNameFromEnvironment( } if (encoding != NULL) { - const char *p; + CONST char *p; Tcl_DString ds; Tcl_DStringInit(&ds); @@ -784,7 +848,7 @@ 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_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); @@ -878,7 +942,7 @@ TclpSetVariables( #elif !defined NO_UNAME if (uname(&name) >= 0) { - const char *native; + CONST char *native; unameOK = 1; @@ -951,12 +1015,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); } /* @@ -981,7 +1039,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 @@ -989,7 +1047,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); @@ -1016,6 +1074,212 @@ 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(&result); + } +#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; + 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 */ /* *---------------------------------------------------------------------- |