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