diff options
Diffstat (limited to 'unix/tclUnixInit.c')
| -rw-r--r-- | unix/tclUnixInit.c | 929 |
1 files changed, 431 insertions, 498 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 4175d37..1617cba 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -6,18 +6,23 @@ * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. - * - * RCS: @(#) $Id: tclUnixInit.c,v 1.55 2005/04/13 21:26:15 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__) +#if defined(__FreeBSD__) && defined(__GNUC__) # include <floatingpoint.h> #endif #if defined(__bsdi__) @@ -26,77 +31,62 @@ # include <dlfcn.h> # endif #endif -#ifdef HAVE_CFBUNDLE -#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 +#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 *); -/* - * Define this if you want to see a lot of output regarding - * stack checking. - */ -#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. + * 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. */ #ifndef TCL_DEFAULT_ENCODING @@ -104,45 +94,45 @@ static Tcl_ThreadDataKey dataKey; #endif /* - * Default directory in which to look for Tcl library scripts. The - * symbol is defined by Makefile. + * Default directory in which to look for Tcl library scripts. The symbol is + * defined by Makefile. */ static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY; /* * Directory in which to look for packages (each package is typically - * installed as a subdirectory of this directory). The symbol is - * defined by Makefile. + * installed as a subdirectory of this directory). The symbol is defined by + * Makefile. */ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; /* - * The following table is used to map from Unix locale strings to - * encoding files. If HAVE_LANGINFO is defined, then this is a fallback - * table when the result from nl_langinfo isn't a recognized encoding. - * Otherwise this is the first list checked for a mapping from env - * encoding to Tcl encoding name. + * The following table is used to map from Unix locale strings to encoding + * files. If HAVE_LANGINFO is defined, then this is a fallback table when the + * result from nl_langinfo isn't a recognized encoding. Otherwise this is the + * first list checked for a mapping from env encoding to Tcl encoding name. */ typedef struct LocaleTable { - CONST char *lang; - CONST char *encoding; + const char *lang; + const char *encoding; } LocaleTable; -/* - * The table below is sorted for the sake of doing binary searches on it. - * The indenting reflects different categories of data. The leftmost - * data represent the encoding names directly implemented by data files - * in Tcl's default encoding directory. Indented by one TAB are the - * encoding names that are common alternative spellings. Indented by - * two TABs are the accumulated "bug fixes" that have been added to - * deal with the wide variability seen among existing platforms. +/* + * The table below is sorted for the sake of doing binary searches on it. The + * indenting reflects different categories of data. The leftmost data + * represent the encoding names directly implemented by data files in Tcl's + * default encoding directory. Indented by one TAB are the encoding names that + * are common alternative spellings. Indented by two TABs are the accumulated + * "bug fixes" that have been added to deal with the wide variability seen + * among existing platforms. */ -static CONST LocaleTable localeTable[] = { +static const LocaleTable localeTable[] = { {"", "iso8859-1"}, + {"ansi-1251", "cp1251"}, {"ansi_x3.4-1968", "iso8859-1"}, {"ascii", "ascii"}, {"big5", "big5"}, @@ -267,7 +257,7 @@ static CONST LocaleTable localeTable[] = { #endif {"ja_jp", "euc-jp"}, {"ja_jp.euc", "euc-jp"}, - {"ja_jp.eucjp", "euc-jp"}, + {"ja_jp.eucjp", "euc-jp"}, {"ja_jp.jis", "iso2022-jp"}, {"ja_jp.mscode", "shiftjis"}, {"ja_jp.sjis", "shiftjis"}, @@ -286,13 +276,13 @@ static CONST LocaleTable localeTable[] = { {"jis0208", "jis0208"}, {"jis0212", "jis0212"}, {"jp_jp", "shiftjis"}, - {"ko", "euc-kr"}, - {"ko_kr", "euc-kr"}, - {"ko_kr.euc", "euc-kr"}, - {"ko_kw.euckw", "euc-kr"}, + {"ko", "euc-kr"}, + {"ko_kr", "euc-kr"}, + {"ko_kr.euc", "euc-kr"}, + {"ko_kw.euckw", "euc-kr"}, {"koi8-r", "koi8-r"}, {"koi8-u", "koi8-u"}, - {"korean", "euc-kr"}, + {"korean", "euc-kr"}, {"ksc5601", "ksc5601"}, {"maccenteuro", "macCentEuro"}, {"maccroatian", "macCroatian"}, @@ -325,14 +315,24 @@ static CONST LocaleTable localeTable[] = { {"zh_tw.big5", "big5"}, }; -#ifndef TCL_NO_STACK_CHECK -static int GetStackSize _ANSI_ARGS_((size_t *stackSizePtr)); -#endif /* TCL_NO_STACK_CHECK */ -#ifdef HAVE_CFBUNDLE -static int MacOSXGetLibraryPath _ANSI_ARGS_(( - Tcl_Interp *interp, int maxPathLen, - char *tclLibPath)); -#endif /* HAVE_CFBUNDLE */ +#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 /* @@ -355,7 +355,7 @@ static int MacOSXGetLibraryPath _ANSI_ARGS_(( */ void -TclpInitPlatform() +TclpInitPlatform(void) { #ifdef DJGPP tclPlatform = TCL_PLATFORM_WINDOWS; @@ -378,20 +378,26 @@ TclpInitPlatform() } /* - * The code below causes SIGPIPE (broken pipe) errors to - * be ignored. This is needed so that Tcl processes don't - * die if they create child processes (e.g. using "exec" or - * "open") that terminate prematurely. The signal handler - * is only set up when the first interpreter is created; - * after this the application can override the handler with - * a different one of its own, if it wants. + * The code below causes SIGPIPE (broken pipe) errors to be ignored. This + * is needed so that Tcl processes don't die if they create child + * processes (e.g. using "exec" or "open") that terminate prematurely. + * The signal handler is only set up when the first interpreter is + * created; after this the application can override the handler with a + * different one of its own, if it wants. */ #ifdef SIGPIPE (void) signal(SIGPIPE, SIG_IGN); #endif /* SIGPIPE */ -#ifdef __FreeBSD__ +#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 @@ -400,27 +406,39 @@ TclpInitPlatform() /* * 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 + /* - * Initialize the C library's locale subsystem. This is required - * for input methods to work properly on X11. We only do this for - * LC_CTYPE because that's the necessary one, and we don't want to - * affect LC_TIME here. The side effect of setting the default - * locale should be to load any locale specific modules that are - * needed by X. [BUG: 5422 3345 4236 2522 2521]. + * Initialize the C library's locale subsystem. This is required for input + * methods to work properly on X11. We only do this for LC_CTYPE because + * that's the necessary one, and we don't want to affect LC_TIME here. + * The side effect of setting the default locale should be to load any + * locale specific modules that are needed by X. [BUG: 5422 3345 4236 2522 + * 2521]. */ setlocale(LC_CTYPE, ""); /* * 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 strtod, but should not have locale - * dependent behavior. + * processing is done in "C" locale regardless. This is needed because Tcl + * relies on routines like strtod, but should not have locale dependent + * behavior. */ setlocale(LC_NUMERIC, "C"); + +#ifdef GET_DARWIN_RELEASE + { + struct utsname name; + + if (!uname(&name)) { + tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); + } + } +#endif } /* @@ -428,49 +446,36 @@ TclpInitPlatform() * * TclpInitLibraryPath -- * - * This is the fallback routine that sets the library path - * if the application has not set one by the first time - * it is needed. + * This is the fallback routine that sets the library path if the + * application has not set one by the first time it is needed. * * Results: - * None. + * None. * * Side effects: - * Sets the library path to an initial value. + * Sets the library path to an initial value. * *------------------------------------------------------------------------- - */ + */ void -TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr) - char **valuePtr; - int *lengthPtr; - Tcl_Encoding *encodingPtr; +TclpInitLibraryPath( + char **valuePtr, + int *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 addition to the orginal TCL_LIBRARY path. + * 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 + * addition to the orginal TCL_LIBRARY path. */ str = getenv("TCL_LIBRARY"); /* INTL: Native. */ @@ -478,12 +483,26 @@ TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr) 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)) { @@ -491,48 +510,49 @@ TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr) * If TCL_LIBRARY is set but refers to a different tcl * installation than the current version, try fiddling with the * specified directory to make it refer to this installation by - * removing the old "tclX.Y" and substituting the current - * version string. + * removing the old "tclX.Y" and substituting the current version + * string. */ 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. + * 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 prefix. */ { -#ifdef HAVE_CFBUNDLE - char tclLibPath[MAXPATHLEN + 1]; +#ifdef HAVE_COREFOUNDATION + char tclLibPath[MAXPATHLEN + 1]; + + if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { + str = tclLibPath; + } else +#endif /* HAVE_COREFOUNDATION */ + { + /* + * TODO: Pull this value from the TIP 59 table. + */ - if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { - str = tclLibPath; - } else -#endif /* HAVE_CFBUNDLE */ - { - /* TODO: Pull this value from the TIP 59 table */ - str = defaultLibraryDir; - } - if (str[0] != '\0') { - objPtr = Tcl_NewStringObj(str, -1); - Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - } + str = defaultLibraryDir; + } + if (str[0] != '\0') { + objPtr = Tcl_NewStringObj(str, -1); + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); + } } 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); + *valuePtr = ckalloc((*lengthPtr) + 1); + memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); } @@ -541,49 +561,51 @@ TclpInitLibraryPath(valuePtr, lengthPtr, encodingPtr) * * TclpSetInitialEncodings -- * - * Based on the locale, determine the encoding of the operating - * system and the default encoding for newly opened files. + * Based on the locale, determine the encoding of the operating system + * and the default encoding for newly opened files. * - * Called at process initialization time, and part way through - * startup, we verify that the initial encodings were correctly - * setup. Depending on Tcl's environment, there may not have been - * enough information first time through (above). + * Called at process initialization time, and part way through startup, + * we verify that the initial encodings were correctly setup. Depending + * on Tcl's environment, there may not have been enough information first + * time through (above). * * Results: * None. * * Side effects: - * The Tcl library path is converted from native encoding to UTF-8, - * on the first call, and the encodings may be changed on first or - * second call. + * The Tcl library path is converted from native encoding to UTF-8, on + * the first call, and the encodings may be changed on first or second + * call. * *--------------------------------------------------------------------------- */ void -TclpSetInitialEncodings() +TclpSetInitialEncodings(void) { Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, - TclpGetEncodingNameFromEnvironment(&encodingName)); + Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } void -TclpSetInterfaces() +TclpSetInterfaces(void) { - /* do nothing */ + /* do nothing */ } -static CONST char * -SearchKnownEncodings(encoding) - CONST char *encoding; +static const char * +SearchKnownEncodings( + const char *encoding) { int left = 0; int right = sizeof(localeTable)/sizeof(LocaleTable); + while (left <= right) { int test = (left + right)/2; int code = strcmp(localeTable[test].lang, encoding); + if (code == 0) { return localeTable[test].encoding; } @@ -596,25 +618,33 @@ SearchKnownEncodings(encoding) return NULL; } -CONST char * -TclpGetEncodingNameFromEnvironment(bufPtr) - Tcl_DString *bufPtr; +const char * +Tcl_GetEncodingNameFromEnvironment( + Tcl_DString *bufPtr) { - CONST char *encoding; - CONST char *knownEncoding; + const char *encoding; + const char *knownEncoding; Tcl_DStringInit(bufPtr); /* * Determine the current encoding from the LC_* or LANG environment - * variables. We previously used setlocale() to determine the locale, - * but this does not work on some systems (e.g. Linux/i386 RH 5.0). + * variables. We previously used setlocale() to determine the locale, but + * this does not work on some systems (e.g. Linux/i386 RH 5.0). */ + #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; - /* Use a DString so we can modify case. */ + /* + * Use a DString so we can modify case. + */ + Tcl_DStringInit(&ds); encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); Tcl_UtfToLower(Tcl_DStringValue(&ds)); @@ -632,9 +662,10 @@ TclpGetEncodingNameFromEnvironment(bufPtr) #endif /* HAVE_LANGINFO */ /* - * Classic fallback check. This tries a homebrew algorithm to - * determine what encoding should be used based on env vars. + * Classic fallback check. This tries a homebrew algorithm to determine + * what encoding should be used based on env vars. */ + encoding = getenv("LC_ALL"); if (encoding == NULL || encoding[0] == '\0') { @@ -648,7 +679,7 @@ TclpGetEncodingNameFromEnvironment(bufPtr) } if (encoding != NULL) { - CONST char *p; + const char *p; Tcl_DString ds; Tcl_DStringInit(&ds); @@ -668,8 +699,8 @@ TclpGetEncodingNameFromEnvironment(bufPtr) } /* - * We didn't recognize the full value as an encoding name. - * If there is an encoding subfield, we can try to guess from that. + * We didn't recognize the full value as an encoding name. If there is + * an encoding subfield, we can try to guess from that. */ for (p = encoding; *p != '\0'; p++) { @@ -699,9 +730,9 @@ TclpGetEncodingNameFromEnvironment(bufPtr) * * TclpSetVariables -- * - * Performs platform-specific interpreter initialization related to - * the tcl_library and tcl_platform variables, and other platform- - * specific things. + * Performs platform-specific interpreter initialization related to the + * tcl_library and tcl_platform variables, and other platform-specific + * things. * * Results: * None. @@ -714,77 +745,114 @@ TclpGetEncodingNameFromEnvironment(bufPtr) */ void -TclpSetVariables(interp) - Tcl_Interp *interp; +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_CFBUNDLE +#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_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; - Tcl_DString ds; - 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_GLOBAL_ONLY | TCL_APPEND_VALUE); - str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); - if ((str != NULL) && (str[0] != '\0')) { - char *p = Tcl_DStringValue(&ds); - /* convert DYLD_FRAMEWORK_PATH from colon to space separated */ - do { - if(*p == ':') *p = ' '; - } while (*p++); - Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_DStringFree(&ds); - } - if ((bundleRef = CFBundleGetMainBundle())) { - CFURLRef frameworksURL; - Tcl_StatBuf statBuf; - if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) { - if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, - tclLibPath, MAXPATHLEN) && - ! TclOSstat(tclLibPath, &statBuf) && - S_ISDIR(statBuf.st_mode)) { - Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - } - CFRelease(frameworksURL); - } - if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) { - if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, - tclLibPath, MAXPATHLEN) && - ! TclOSstat(tclLibPath, &statBuf) && - S_ISDIR(statBuf.st_mode)) { - Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - } - CFRelease(frameworksURL); - } - } - Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, - TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + 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_GLOBAL_ONLY | TCL_APPEND_VALUE); + + str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); + if ((str != NULL) && (str[0] != '\0')) { + char *p = Tcl_DStringValue(&ds); + + /* + * Convert DYLD_FRAMEWORK_PATH from colon to space separated. + */ + + do { + if (*p == ':') { + *p = ' '; + } + } while (*p++); + Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + Tcl_SetVar(interp, "tcl_pkgPath", " ", + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + Tcl_DStringFree(&ds); + } + bundleRef = CFBundleGetMainBundle(); + if (bundleRef) { + CFURLRef frameworksURL; + Tcl_StatBuf statBuf; + + frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef); + if (frameworksURL) { + if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, + (unsigned char*) tclLibPath, MAXPATHLEN) && + ! TclOSstat(tclLibPath, &statBuf) && + S_ISDIR(statBuf.st_mode)) { + Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + Tcl_SetVar(interp, "tcl_pkgPath", " ", + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + } + CFRelease(frameworksURL); + } + frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef); + if (frameworksURL) { + if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, + (unsigned char*) tclLibPath, MAXPATHLEN) && + ! TclOSstat(tclLibPath, &statBuf) && + S_ISDIR(statBuf.st_mode)) { + Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + Tcl_SetVar(interp, "tcl_pkgPath", " ", + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); + } + CFRelease(frameworksURL); + } + } + Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } else -#endif /* HAVE_CFBUNDLE */ +#endif /* HAVE_COREFOUNDATION */ { - Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); } #ifdef DJGPP @@ -792,10 +860,41 @@ TclpSetVariables(interp) #else Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); #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; @@ -804,11 +903,11 @@ TclpSetVariables(interp) Tcl_DStringFree(&ds); /* - * The following code is a special hack to handle differences in - * the way version information is returned by uname. On most - * systems the full version number is available in name.release. - * However, under AIX the major version number is in - * name.version and the minor version number is in name.release. + * The following code is a special hack to handle differences in the + * way version information is returned by uname. On most systems the + * full version number is available in name.release. However, under + * AIX the major version number is in name.version and the minor + * version number is in name.release. */ if ((strchr(name.release, '.') != NULL) @@ -817,9 +916,12 @@ TclpSetVariables(interp) TCL_GLOBAL_ONLY); } else { #ifdef DJGPP - /* For some obscure reason DJGPP puts major version into - * name.release and minor into name.version. As of DJGPP 2.04 - * this is documented in djgpp libc.info file*/ + /* + * For some obscure reason DJGPP puts major version into + * name.release and minor into name.version. As of DJGPP 2.04 this + * is documented in djgpp libc.info file. + */ + Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", @@ -834,12 +936,12 @@ TclpSetVariables(interp) 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); @@ -847,20 +949,30 @@ TclpSetVariables(interp) } /* - * 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); } /* @@ -868,15 +980,14 @@ TclpSetVariables(interp) * * TclpFindVariable -- * - * Locate the entry in environ for a given name. On Unix this - * routine is case sensetive, on Windows this matches mixed case. + * Locate the entry in environ for a given name. On Unix this routine is + * case sensetive, on Windows this matches mixed case. * * Results: - * The return value is the index in environ of an entry with the - * name "name", or -1 if there is no such entry. The integer at - * *lengthPtr is filled in with the length of name (if a matching - * entry is found) or the length of the environ array (if no matching - * entry is found). + * The return value is the index in environ of an entry with the name + * "name", or -1 if there is no such entry. The integer at *lengthPtr is + * filled in with the length of name (if a matching entry is found) or + * the length of the environ array (if no matching entry is found). * * Side effects: * None. @@ -885,16 +996,16 @@ TclpSetVariables(interp) */ int -TclpFindVariable(name, lengthPtr) - CONST char *name; /* Name of desired environment variable +TclpFindVariable( + const char *name, /* Name of desired environment variable * (native). */ - int *lengthPtr; /* Used to return length of name (for + int *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, result = -1; - register CONST char *env, *p1, *p2; + register const char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); @@ -916,211 +1027,19 @@ TclpFindVariable(name, lengthPtr) *lengthPtr = i; - done: + done: Tcl_DStringFree(&envString); 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() -{ -#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(). */ - 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(stackSizePtr) - 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 */ /* *---------------------------------------------------------------------- * * MacOSXGetLibraryPath -- * - * If we have a bundle structure for the Tcl installation, - * then check there first to see if we can find the libraries - * there. + * If we have a bundle structure for the Tcl installation, then check + * there first to see if we can find the libraries there. * * Results: * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. @@ -1131,15 +1050,29 @@ GetStackSize(stackSizePtr) *---------------------------------------------------------------------- */ -#ifdef HAVE_CFBUNDLE +#ifdef HAVE_COREFOUNDATION static int -MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath) +MacOSXGetLibraryPath( + Tcl_Interp *interp, + int maxPathLen, + char *tclLibPath) { int foundInFramework = TCL_ERROR; + #ifdef TCL_FRAMEWORK - foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, - "com.tcltk.tcllibrary", TCL_VERSION, 0, maxPathLen, tclLibPath); + foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, + "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, + tclLibPath); #endif + return foundInFramework; } -#endif /* HAVE_CFBUNDLE */ +#endif /* HAVE_COREFOUNDATION */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |