tclUnixInit.c Go to the documentation of this file. /* * tclUnixInit.c -- * * Contains the Unix-specific interpreter initialization functions. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * * RCS: @(#) $Id: tclUnixInit.c,v 1.82 2007/12/13 15:28:42 dgp Exp $ */ #include "tclInt.h" #include <stddef.h> #include <locale.h> #ifdef HAVE_LANGINFO # 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__) && defined(__GNUC__) # include <floatingpoint.h> #endif #if defined(__bsdi__) # include <sys/param.h> # if _BSDI_VERSION > 199501 # include <dlfcn.h> # endif #endif #ifdef HAVE_COREFOUNDATION #include <CoreFoundation/CoreFoundation.h> #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. */ #ifndef TCL_DEFAULT_ENCODING #define TCL_DEFAULT_ENCODING "iso8859-1" #endif /* * 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. */ 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. */ typedef struct LocaleTable { 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. */ static CONST LocaleTable localeTable[] = { {"", "iso8859-1"}, {"ansi-1251", "cp1251"}, {"ansi_x3.4-1968", "iso8859-1"}, {"ascii", "ascii"}, {"big5", "big5"}, {"cp1250", "cp1250"}, {"cp1251", "cp1251"}, {"cp1252", "cp1252"}, {"cp1253", "cp1253"}, {"cp1254", "cp1254"}, {"cp1255", "cp1255"}, {"cp1256", "cp1256"}, {"cp1257", "cp1257"}, {"cp1258", "cp1258"}, {"cp437", "cp437"}, {"cp737", "cp737"}, {"cp775", "cp775"}, {"cp850", "cp850"}, {"cp852", "cp852"}, {"cp855", "cp855"}, {"cp857", "cp857"}, {"cp860", "cp860"}, {"cp861", "cp861"}, {"cp862", "cp862"}, {"cp863", "cp863"}, {"cp864", "cp864"}, {"cp865", "cp865"}, {"cp866", "cp866"}, {"cp869", "cp869"}, {"cp874", "cp874"}, {"cp932", "cp932"}, {"cp936", "cp936"}, {"cp949", "cp949"}, {"cp950", "cp950"}, {"dingbats", "dingbats"}, {"ebcdic", "ebcdic"}, {"euc-cn", "euc-cn"}, {"euc-jp", "euc-jp"}, {"euc-kr", "euc-kr"}, {"eucjp", "euc-jp"}, {"euckr", "euc-kr"}, {"euctw", "euc-cn"}, {"gb12345", "gb12345"}, {"gb1988", "gb1988"}, {"gb2312", "gb2312"}, {"gb2312-1980", "gb2312"}, {"gb2312-raw", "gb2312-raw"}, {"greek8", "cp869"}, {"ibm1250", "cp1250"}, {"ibm1251", "cp1251"}, {"ibm1252", "cp1252"}, {"ibm1253", "cp1253"}, {"ibm1254", "cp1254"}, {"ibm1255", "cp1255"}, {"ibm1256", "cp1256"}, {"ibm1257", "cp1257"}, {"ibm1258", "cp1258"}, {"ibm437", "cp437"}, {"ibm737", "cp737"}, {"ibm775", "cp775"}, {"ibm850", "cp850"}, {"ibm852", "cp852"}, {"ibm855", "cp855"}, {"ibm857", "cp857"}, {"ibm860", "cp860"}, {"ibm861", "cp861"}, {"ibm862", "cp862"}, {"ibm863", "cp863"}, {"ibm864", "cp864"}, {"ibm865", "cp865"}, {"ibm866", "cp866"}, {"ibm869", "cp869"}, {"ibm874", "cp874"}, {"ibm932", "cp932"}, {"ibm936", "cp936"}, {"ibm949", "cp949"}, {"ibm950", "cp950"}, {"iso-2022", "iso2022"}, {"iso-2022-jp", "iso2022-jp"}, {"iso-2022-kr", "iso2022-kr"}, {"iso-8859-1", "iso8859-1"}, {"iso-8859-10", "iso8859-10"}, {"iso-8859-13", "iso8859-13"}, {"iso-8859-14", "iso8859-14"}, {"iso-8859-15", "iso8859-15"}, {"iso-8859-16", "iso8859-16"}, {"iso-8859-2", "iso8859-2"}, {"iso-8859-3", "iso8859-3"}, {"iso-8859-4", "iso8859-4"}, {"iso-8859-5", "iso8859-5"}, {"iso-8859-6", "iso8859-6"}, {"iso-8859-7", "iso8859-7"}, {"iso-8859-8", "iso8859-8"}, {"iso-8859-9", "iso8859-9"}, {"iso2022", "iso2022"}, {"iso2022-jp", "iso2022-jp"}, {"iso2022-kr", "iso2022-kr"}, {"iso8859-1", "iso8859-1"}, {"iso8859-10", "iso8859-10"}, {"iso8859-13", "iso8859-13"}, {"iso8859-14", "iso8859-14"}, {"iso8859-15", "iso8859-15"}, {"iso8859-16", "iso8859-16"}, {"iso8859-2", "iso8859-2"}, {"iso8859-3", "iso8859-3"}, {"iso8859-4", "iso8859-4"}, {"iso8859-5", "iso8859-5"}, {"iso8859-6", "iso8859-6"}, {"iso8859-7", "iso8859-7"}, {"iso8859-8", "iso8859-8"}, {"iso8859-9", "iso8859-9"}, {"iso88591", "iso8859-1"}, {"iso885915", "iso8859-15"}, {"iso88592", "iso8859-2"}, {"iso88595", "iso8859-5"}, {"iso88596", "iso8859-6"}, {"iso88597", "iso8859-7"}, {"iso88598", "iso8859-8"}, {"iso88599", "iso8859-9"}, #ifdef hpux {"ja", "shiftjis"}, #else {"ja", "euc-jp"}, #endif {"ja_jp", "euc-jp"}, {"ja_jp.euc", "euc-jp"}, {"ja_jp.eucjp", "euc-jp"}, {"ja_jp.jis", "iso2022-jp"}, {"ja_jp.mscode", "shiftjis"}, {"ja_jp.sjis", "shiftjis"}, {"ja_jp.ujis", "euc-jp"}, {"japan", "euc-jp"}, #ifdef hpux {"japanese", "shiftjis"}, #else {"japanese", "euc-jp"}, #endif {"japanese-sjis", "shiftjis"}, {"japanese-ujis", "euc-jp"}, {"japanese.euc", "euc-jp"}, {"japanese.sjis", "shiftjis"}, {"jis0201", "jis0201"}, {"jis0208", "jis0208"}, {"jis0212", "jis0212"}, {"jp_jp", "shiftjis"}, {"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"}, {"ksc5601", "ksc5601"}, {"maccenteuro", "macCentEuro"}, {"maccroatian", "macCroatian"}, {"maccyrillic", "macCyrillic"}, {"macdingbats", "macDingbats"}, {"macgreek", "macGreek"}, {"maciceland", "macIceland"}, {"macjapan", "macJapan"}, {"macroman", "macRoman"}, {"macromania", "macRomania"}, {"macthai", "macThai"}, {"macturkish", "macTurkish"}, {"macukraine", "macUkraine"}, {"roman8", "iso8859-1"}, {"ru", "iso8859-5"}, {"ru_ru", "iso8859-5"}, {"ru_su", "iso8859-5"}, {"shiftjis", "shiftjis"}, {"sjis", "shiftjis"}, {"symbol", "symbol"}, {"tis-620", "tis-620"}, {"tis620", "tis-620"}, {"turkish8", "cp857"}, {"utf8", "utf-8"}, {"zh", "cp936"}, {"zh_cn.gb2312", "euc-cn"}, {"zh_cn.gbk", "euc-cn"}, {"zh_cz.gb2312", "euc-cn"}, {"zh_tw", "euc-tw"}, {"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(TCL_THREADS) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || ( \ defined(__LP64__) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ 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  /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * * Initialize all the platform-dependant things like signals and * floating-point error handling. * * Called at process initialization time. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclpInitPlatform(void) { #ifdef DJGPP tclPlatform = TCL_PLATFORM_WINDOWS; #else tclPlatform = TCL_PLATFORM_UNIX; #endif /* * Make sure, that the standard FDs exist. [Bug 772288] */ if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_RDONLY); } if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_WRONLY); } if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { open("/dev/null", O_WRONLY); } /* * 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 */ #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 #if defined(__bsdi__) && (_BSDI_VERSION > 199501) /* * Find local symbols. Don't report an error if we fail. */ (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]. */ 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. */ setlocale(LC_NUMERIC, "C"); #ifdef GET_DARWIN_RELEASE { struct utsname name; if (!uname(&name)) { tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); } } #endif }  /* *--------------------------------------------------------------------------- * * 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. * * Results: * None. * * Side effects: * Sets the library path to an initial value. * *------------------------------------------------------------------------- */ void TclpInitLibraryPath( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 Tcl_Obj *pathPtr, *objPtr; CONST char *str; Tcl_DString buffer; pathPtr = Tcl_NewObj(); /* * 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. */ Tcl_ExternalToUtfDString(NULL, str, -1, &buffer); 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_SplitPath(str, &pathc, &pathv); if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { /* * 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. */ 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); } ckfree((char *) 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 prefix. */ { #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. */ 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(*valuePtr, str, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); }  /* *--------------------------------------------------------------------------- * * TclpSetInitialEncodings -- * * 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). * * 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. * *--------------------------------------------------------------------------- */ void TclpSetInitialEncodings(void) { Tcl_DString encodingName; Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)); Tcl_DStringFree(&encodingName); } void TclpSetInterfaces(void) { /* do nothing */ } 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; } if (code < 0) { left = test+1; } else { right = test-1; } } return NULL; } CONST char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { 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). */ #ifdef HAVE_LANGINFO 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. */ Tcl_DStringInit(&ds); encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); Tcl_UtfToLower(Tcl_DStringValue(&ds)); knownEncoding = SearchKnownEncodings(encoding); if (knownEncoding != NULL) { Tcl_DStringAppend(bufPtr, knownEncoding, -1); } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { Tcl_DStringAppend(bufPtr, encoding, -1); } Tcl_DStringFree(&ds); if (Tcl_DStringLength(bufPtr)) { return Tcl_DStringValue(bufPtr); } } #endif /* HAVE_LANGINFO */ /* * 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') { encoding = getenv("LC_CTYPE"); } if (encoding == NULL || encoding[0] == '\0') { encoding = getenv("LANG"); } if (encoding == NULL || encoding[0] == '\0') { encoding = NULL; } if (encoding != NULL) { CONST char *p; Tcl_DString ds; Tcl_DStringInit(&ds); p = encoding; encoding = Tcl_DStringAppend(&ds, p, -1); Tcl_UtfToLower(Tcl_DStringValue(&ds)); knownEncoding = SearchKnownEncodings(encoding); if (knownEncoding != NULL) { Tcl_DStringAppend(bufPtr, knownEncoding, -1); } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { Tcl_DStringAppend(bufPtr, encoding, -1); } if (Tcl_DStringLength(bufPtr)) { Tcl_DStringFree(&ds); return Tcl_DStringValue(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. */ for (p = encoding; *p != '\0'; p++) { if (*p == '.') { p++; break; } } if (*p != '\0') { knownEncoding = SearchKnownEncodings(p); if (knownEncoding != NULL) { Tcl_DStringAppend(bufPtr, knownEncoding, -1); } else if (NULL != Tcl_GetEncoding(NULL, p)) { Tcl_DStringAppend(bufPtr, p, -1); } } Tcl_DStringFree(&ds); if (Tcl_DStringLength(bufPtr)) { return Tcl_DStringValue(bufPtr); } } return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1); }  /* *--------------------------------------------------------------------------- * * TclpSetVariables -- * * Performs platform-specific interpreter initialization related to the * tcl_library and tcl_platform variables, and other platform-specific * things. * * Results: * None. * * Side effects: * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl * variables. * *---------------------------------------------------------------------- */ void TclpSetVariables( Tcl_Interp *interp) { #ifndef NO_UNAME struct utsname name; #endif int unameOK; Tcl_DString ds; #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; 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_COREFOUNDATION */ { Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); } #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); #endif unameOK = 0; #ifndef NO_UNAME if (uname(&name) >= 0) { CONST char *native; unameOK = 1; native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds); Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY); 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. */ if ((strchr(name.release, '.') != NULL) || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, 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. */ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); #else Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); #endif /* DJGPP */ } Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, TCL_GLOBAL_ONLY); } #endif /* !NO_UNAME */ if (!unameOK) { Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); } /* * Copy the username of the real user (according to getuid()) into * tcl_platform(user). */ { 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); } }  /* *---------------------------------------------------------------------- * * TclpFindVariable -- * * 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). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpFindVariable( 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 * entries in environ (for unsuccessful * searches). */ { int i, result = -1; register CONST char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p2 = name; for (; *p2 == *p1; p1++, p2++) { /* NULL loop body. */ } if ((*p1 == '=') && (*p2 == '\0')) { *lengthPtr = p2 - name; result = i; goto done; } Tcl_DStringFree(&envString); } *lengthPtr = i; done: Tcl_DStringFree(&envString); 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); } else { tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr + stackSize); } } 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 */  /* *---------------------------------------------------------------------- * * MacOSXGetLibraryPath -- * * 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. * * Side effects: * Same as for Tcl_MacOSXOpenVersionedBundleResources. * *---------------------------------------------------------------------- */ #ifdef HAVE_COREFOUNDATION static int MacOSXGetLibraryPath( Tcl_Interp *interp, int maxPathLen, char *tclLibPath) { int foundInFramework = TCL_ERROR; #ifdef TCL_FRAMEWORK foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath); #endif return foundInFramework; } #endif /* HAVE_COREFOUNDATION */  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

• ソフトウェア開発
• ホームページ制作
• Doxygen版
• STLport版