diff options
Diffstat (limited to 'unix/tclUnixInit.c')
| -rw-r--r-- | unix/tclUnixInit.c | 439 |
1 files changed, 355 insertions, 84 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index eec0fd9..93f2964 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -9,6 +9,8 @@ */ #include "tclInt.h" +#include <stddef.h> +#include <locale.h> #ifdef HAVE_LANGINFO # include <langinfo.h> # ifdef __APPLE__ @@ -37,6 +39,11 @@ DLLIMPORT extern __stdcall void FreeLibrary(void *); DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *); DLLIMPORT extern __stdcall void GetSystemInfo(void *); +#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", @@ -77,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. @@ -108,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; /* @@ -123,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"}, @@ -308,13 +373,16 @@ 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) && ( \ - (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)\ ))) @@ -333,7 +401,7 @@ long tclMacOSXDarwinRelease = 0; * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals and + * Initialize all the platform-dependent things like signals and * floating-point error handling. * * Called at process initialization time. @@ -384,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 @@ -409,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. */ @@ -446,12 +522,12 @@ 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; pathPtr = Tcl_NewObj(); @@ -470,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); @@ -487,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)) { @@ -501,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); } /* @@ -535,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); } @@ -575,9 +653,15 @@ 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); @@ -598,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); @@ -659,7 +743,7 @@ Tcl_GetEncodingNameFromEnvironment( } if (encoding != NULL) { - const char *p; + CONST char *p; Tcl_DString ds; Tcl_DStringInit(&ds); @@ -724,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) @@ -779,21 +826,38 @@ TclpSetVariables( #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_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); @@ -809,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); } @@ -826,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); @@ -839,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 @@ -877,7 +941,10 @@ TclpSetVariables( GetSystemInfo(&sysInfo); - Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); + 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) { @@ -888,7 +955,7 @@ TclpSetVariables( #elif !defined NO_UNAME if (uname(&name) >= 0) { - const char *native; + CONST char *native; unameOK = 1; @@ -961,12 +1028,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); } /* @@ -991,7 +1052,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 @@ -999,7 +1060,7 @@ TclpFindVariable( * searches). */ { int i, result = -1; - const char *env, *p1, *p2; + register CONST char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); @@ -1026,6 +1087,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 */ + /* *---------------------------------------------------------------------- * |