[25] | 1 | /* |
---|
| 2 | * tclUnixInit.c -- |
---|
| 3 | * |
---|
| 4 | * Contains the Unix-specific interpreter initialization functions. |
---|
| 5 | * |
---|
| 6 | * Copyright (c) 1995-1997 Sun Microsystems, Inc. |
---|
| 7 | * Copyright (c) 1999 by Scriptics Corporation. |
---|
| 8 | * All rights reserved. |
---|
| 9 | * |
---|
| 10 | * RCS: @(#) $Id: tclUnixInit.c,v 1.82 2007/12/13 15:28:42 dgp Exp $ |
---|
| 11 | */ |
---|
| 12 | |
---|
| 13 | #include "tclInt.h" |
---|
| 14 | #include <stddef.h> |
---|
| 15 | #include <locale.h> |
---|
| 16 | #ifdef HAVE_LANGINFO |
---|
| 17 | # include <langinfo.h> |
---|
| 18 | # ifdef __APPLE__ |
---|
| 19 | # if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 |
---|
| 20 | /* Support for weakly importing nl_langinfo on Darwin. */ |
---|
| 21 | # define WEAK_IMPORT_NL_LANGINFO |
---|
| 22 | extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE; |
---|
| 23 | # endif |
---|
| 24 | # endif |
---|
| 25 | #endif |
---|
| 26 | #include <sys/resource.h> |
---|
| 27 | #if defined(__FreeBSD__) && defined(__GNUC__) |
---|
| 28 | # include <floatingpoint.h> |
---|
| 29 | #endif |
---|
| 30 | #if defined(__bsdi__) |
---|
| 31 | # include <sys/param.h> |
---|
| 32 | # if _BSDI_VERSION > 199501 |
---|
| 33 | # include <dlfcn.h> |
---|
| 34 | # endif |
---|
| 35 | #endif |
---|
| 36 | #ifdef HAVE_COREFOUNDATION |
---|
| 37 | #include <CoreFoundation/CoreFoundation.h> |
---|
| 38 | #endif |
---|
| 39 | |
---|
| 40 | /* |
---|
| 41 | * Define TCL_NO_STACK_CHECK in the compiler options if you want to revert to |
---|
| 42 | * the old behavior of never checking the stack. |
---|
| 43 | */ |
---|
| 44 | |
---|
| 45 | /* |
---|
| 46 | * Define this if you want to see a lot of output regarding stack checking. |
---|
| 47 | */ |
---|
| 48 | |
---|
| 49 | #undef TCL_DEBUG_STACK_CHECK |
---|
| 50 | |
---|
| 51 | /* |
---|
| 52 | * Values used to compute how much space is really available for Tcl's use for |
---|
| 53 | * the stack. |
---|
| 54 | * |
---|
| 55 | * The getrlimit() function is documented to return the maximum stack size in |
---|
| 56 | * bytes. However, with threads enabled, the pthread library on some platforms |
---|
| 57 | * does bad things to the stack size limits. First, the limits cannot be |
---|
| 58 | * changed. Second, they appear to be sometimes reported incorrectly. |
---|
| 59 | * |
---|
| 60 | * The defines below may need to be adjusted if more platforms have this |
---|
| 61 | * broken behavior with threads enabled. |
---|
| 62 | */ |
---|
| 63 | |
---|
| 64 | #ifndef TCL_MAGIC_STACK_DIVISOR |
---|
| 65 | #define TCL_MAGIC_STACK_DIVISOR 1 |
---|
| 66 | #endif |
---|
| 67 | #ifndef TCL_RESERVED_STACK_PAGES |
---|
| 68 | #define TCL_RESERVED_STACK_PAGES 8 |
---|
| 69 | #endif |
---|
| 70 | |
---|
| 71 | /* |
---|
| 72 | * Thread specific data for stack checking. |
---|
| 73 | */ |
---|
| 74 | |
---|
| 75 | #ifndef TCL_NO_STACK_CHECK |
---|
| 76 | typedef struct ThreadSpecificData { |
---|
| 77 | int *outerVarPtr; /* The "outermost" stack frame pointer for |
---|
| 78 | * this thread. */ |
---|
| 79 | int *stackBound; /* The current stack boundary */ |
---|
| 80 | } ThreadSpecificData; |
---|
| 81 | static Tcl_ThreadDataKey dataKey; |
---|
| 82 | #ifdef TCL_CROSS_COMPILE |
---|
| 83 | static int stackGrowsDown = -1; |
---|
| 84 | static int StackGrowsDown(int *parent); |
---|
| 85 | #elif defined(TCL_STACK_GROWS_UP) |
---|
| 86 | #define stackGrowsDown 0 |
---|
| 87 | #else |
---|
| 88 | #define stackGrowsDown 1 |
---|
| 89 | #endif |
---|
| 90 | #endif /* TCL_NO_STACK_CHECK */ |
---|
| 91 | |
---|
| 92 | #ifdef TCL_DEBUG_STACK_CHECK |
---|
| 93 | #define STACK_DEBUG(args) printf args |
---|
| 94 | #else |
---|
| 95 | #define STACK_DEBUG(args) (void)0 |
---|
| 96 | #endif /* TCL_DEBUG_STACK_CHECK */ |
---|
| 97 | |
---|
| 98 | /* |
---|
| 99 | * Tcl tries to use standard and homebrew methods to guess the right encoding |
---|
| 100 | * on the platform. However, there is always a final fallback, and this value |
---|
| 101 | * is it. Make sure it is a real Tcl encoding. |
---|
| 102 | */ |
---|
| 103 | |
---|
| 104 | #ifndef TCL_DEFAULT_ENCODING |
---|
| 105 | #define TCL_DEFAULT_ENCODING "iso8859-1" |
---|
| 106 | #endif |
---|
| 107 | |
---|
| 108 | /* |
---|
| 109 | * Default directory in which to look for Tcl library scripts. The symbol is |
---|
| 110 | * defined by Makefile. |
---|
| 111 | */ |
---|
| 112 | |
---|
| 113 | static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY; |
---|
| 114 | |
---|
| 115 | /* |
---|
| 116 | * Directory in which to look for packages (each package is typically |
---|
| 117 | * installed as a subdirectory of this directory). The symbol is defined by |
---|
| 118 | * Makefile. |
---|
| 119 | */ |
---|
| 120 | |
---|
| 121 | static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; |
---|
| 122 | |
---|
| 123 | /* |
---|
| 124 | * The following table is used to map from Unix locale strings to encoding |
---|
| 125 | * files. If HAVE_LANGINFO is defined, then this is a fallback table when the |
---|
| 126 | * result from nl_langinfo isn't a recognized encoding. Otherwise this is the |
---|
| 127 | * first list checked for a mapping from env encoding to Tcl encoding name. |
---|
| 128 | */ |
---|
| 129 | |
---|
| 130 | typedef struct LocaleTable { |
---|
| 131 | CONST char *lang; |
---|
| 132 | CONST char *encoding; |
---|
| 133 | } LocaleTable; |
---|
| 134 | |
---|
| 135 | /* |
---|
| 136 | * The table below is sorted for the sake of doing binary searches on it. The |
---|
| 137 | * indenting reflects different categories of data. The leftmost data |
---|
| 138 | * represent the encoding names directly implemented by data files in Tcl's |
---|
| 139 | * default encoding directory. Indented by one TAB are the encoding names that |
---|
| 140 | * are common alternative spellings. Indented by two TABs are the accumulated |
---|
| 141 | * "bug fixes" that have been added to deal with the wide variability seen |
---|
| 142 | * among existing platforms. |
---|
| 143 | */ |
---|
| 144 | |
---|
| 145 | static CONST LocaleTable localeTable[] = { |
---|
| 146 | {"", "iso8859-1"}, |
---|
| 147 | {"ansi-1251", "cp1251"}, |
---|
| 148 | {"ansi_x3.4-1968", "iso8859-1"}, |
---|
| 149 | {"ascii", "ascii"}, |
---|
| 150 | {"big5", "big5"}, |
---|
| 151 | {"cp1250", "cp1250"}, |
---|
| 152 | {"cp1251", "cp1251"}, |
---|
| 153 | {"cp1252", "cp1252"}, |
---|
| 154 | {"cp1253", "cp1253"}, |
---|
| 155 | {"cp1254", "cp1254"}, |
---|
| 156 | {"cp1255", "cp1255"}, |
---|
| 157 | {"cp1256", "cp1256"}, |
---|
| 158 | {"cp1257", "cp1257"}, |
---|
| 159 | {"cp1258", "cp1258"}, |
---|
| 160 | {"cp437", "cp437"}, |
---|
| 161 | {"cp737", "cp737"}, |
---|
| 162 | {"cp775", "cp775"}, |
---|
| 163 | {"cp850", "cp850"}, |
---|
| 164 | {"cp852", "cp852"}, |
---|
| 165 | {"cp855", "cp855"}, |
---|
| 166 | {"cp857", "cp857"}, |
---|
| 167 | {"cp860", "cp860"}, |
---|
| 168 | {"cp861", "cp861"}, |
---|
| 169 | {"cp862", "cp862"}, |
---|
| 170 | {"cp863", "cp863"}, |
---|
| 171 | {"cp864", "cp864"}, |
---|
| 172 | {"cp865", "cp865"}, |
---|
| 173 | {"cp866", "cp866"}, |
---|
| 174 | {"cp869", "cp869"}, |
---|
| 175 | {"cp874", "cp874"}, |
---|
| 176 | {"cp932", "cp932"}, |
---|
| 177 | {"cp936", "cp936"}, |
---|
| 178 | {"cp949", "cp949"}, |
---|
| 179 | {"cp950", "cp950"}, |
---|
| 180 | {"dingbats", "dingbats"}, |
---|
| 181 | {"ebcdic", "ebcdic"}, |
---|
| 182 | {"euc-cn", "euc-cn"}, |
---|
| 183 | {"euc-jp", "euc-jp"}, |
---|
| 184 | {"euc-kr", "euc-kr"}, |
---|
| 185 | {"eucjp", "euc-jp"}, |
---|
| 186 | {"euckr", "euc-kr"}, |
---|
| 187 | {"euctw", "euc-cn"}, |
---|
| 188 | {"gb12345", "gb12345"}, |
---|
| 189 | {"gb1988", "gb1988"}, |
---|
| 190 | {"gb2312", "gb2312"}, |
---|
| 191 | {"gb2312-1980", "gb2312"}, |
---|
| 192 | {"gb2312-raw", "gb2312-raw"}, |
---|
| 193 | {"greek8", "cp869"}, |
---|
| 194 | {"ibm1250", "cp1250"}, |
---|
| 195 | {"ibm1251", "cp1251"}, |
---|
| 196 | {"ibm1252", "cp1252"}, |
---|
| 197 | {"ibm1253", "cp1253"}, |
---|
| 198 | {"ibm1254", "cp1254"}, |
---|
| 199 | {"ibm1255", "cp1255"}, |
---|
| 200 | {"ibm1256", "cp1256"}, |
---|
| 201 | {"ibm1257", "cp1257"}, |
---|
| 202 | {"ibm1258", "cp1258"}, |
---|
| 203 | {"ibm437", "cp437"}, |
---|
| 204 | {"ibm737", "cp737"}, |
---|
| 205 | {"ibm775", "cp775"}, |
---|
| 206 | {"ibm850", "cp850"}, |
---|
| 207 | {"ibm852", "cp852"}, |
---|
| 208 | {"ibm855", "cp855"}, |
---|
| 209 | {"ibm857", "cp857"}, |
---|
| 210 | {"ibm860", "cp860"}, |
---|
| 211 | {"ibm861", "cp861"}, |
---|
| 212 | {"ibm862", "cp862"}, |
---|
| 213 | {"ibm863", "cp863"}, |
---|
| 214 | {"ibm864", "cp864"}, |
---|
| 215 | {"ibm865", "cp865"}, |
---|
| 216 | {"ibm866", "cp866"}, |
---|
| 217 | {"ibm869", "cp869"}, |
---|
| 218 | {"ibm874", "cp874"}, |
---|
| 219 | {"ibm932", "cp932"}, |
---|
| 220 | {"ibm936", "cp936"}, |
---|
| 221 | {"ibm949", "cp949"}, |
---|
| 222 | {"ibm950", "cp950"}, |
---|
| 223 | {"iso-2022", "iso2022"}, |
---|
| 224 | {"iso-2022-jp", "iso2022-jp"}, |
---|
| 225 | {"iso-2022-kr", "iso2022-kr"}, |
---|
| 226 | {"iso-8859-1", "iso8859-1"}, |
---|
| 227 | {"iso-8859-10", "iso8859-10"}, |
---|
| 228 | {"iso-8859-13", "iso8859-13"}, |
---|
| 229 | {"iso-8859-14", "iso8859-14"}, |
---|
| 230 | {"iso-8859-15", "iso8859-15"}, |
---|
| 231 | {"iso-8859-16", "iso8859-16"}, |
---|
| 232 | {"iso-8859-2", "iso8859-2"}, |
---|
| 233 | {"iso-8859-3", "iso8859-3"}, |
---|
| 234 | {"iso-8859-4", "iso8859-4"}, |
---|
| 235 | {"iso-8859-5", "iso8859-5"}, |
---|
| 236 | {"iso-8859-6", "iso8859-6"}, |
---|
| 237 | {"iso-8859-7", "iso8859-7"}, |
---|
| 238 | {"iso-8859-8", "iso8859-8"}, |
---|
| 239 | {"iso-8859-9", "iso8859-9"}, |
---|
| 240 | {"iso2022", "iso2022"}, |
---|
| 241 | {"iso2022-jp", "iso2022-jp"}, |
---|
| 242 | {"iso2022-kr", "iso2022-kr"}, |
---|
| 243 | {"iso8859-1", "iso8859-1"}, |
---|
| 244 | {"iso8859-10", "iso8859-10"}, |
---|
| 245 | {"iso8859-13", "iso8859-13"}, |
---|
| 246 | {"iso8859-14", "iso8859-14"}, |
---|
| 247 | {"iso8859-15", "iso8859-15"}, |
---|
| 248 | {"iso8859-16", "iso8859-16"}, |
---|
| 249 | {"iso8859-2", "iso8859-2"}, |
---|
| 250 | {"iso8859-3", "iso8859-3"}, |
---|
| 251 | {"iso8859-4", "iso8859-4"}, |
---|
| 252 | {"iso8859-5", "iso8859-5"}, |
---|
| 253 | {"iso8859-6", "iso8859-6"}, |
---|
| 254 | {"iso8859-7", "iso8859-7"}, |
---|
| 255 | {"iso8859-8", "iso8859-8"}, |
---|
| 256 | {"iso8859-9", "iso8859-9"}, |
---|
| 257 | {"iso88591", "iso8859-1"}, |
---|
| 258 | {"iso885915", "iso8859-15"}, |
---|
| 259 | {"iso88592", "iso8859-2"}, |
---|
| 260 | {"iso88595", "iso8859-5"}, |
---|
| 261 | {"iso88596", "iso8859-6"}, |
---|
| 262 | {"iso88597", "iso8859-7"}, |
---|
| 263 | {"iso88598", "iso8859-8"}, |
---|
| 264 | {"iso88599", "iso8859-9"}, |
---|
| 265 | #ifdef hpux |
---|
| 266 | {"ja", "shiftjis"}, |
---|
| 267 | #else |
---|
| 268 | {"ja", "euc-jp"}, |
---|
| 269 | #endif |
---|
| 270 | {"ja_jp", "euc-jp"}, |
---|
| 271 | {"ja_jp.euc", "euc-jp"}, |
---|
| 272 | {"ja_jp.eucjp", "euc-jp"}, |
---|
| 273 | {"ja_jp.jis", "iso2022-jp"}, |
---|
| 274 | {"ja_jp.mscode", "shiftjis"}, |
---|
| 275 | {"ja_jp.sjis", "shiftjis"}, |
---|
| 276 | {"ja_jp.ujis", "euc-jp"}, |
---|
| 277 | {"japan", "euc-jp"}, |
---|
| 278 | #ifdef hpux |
---|
| 279 | {"japanese", "shiftjis"}, |
---|
| 280 | #else |
---|
| 281 | {"japanese", "euc-jp"}, |
---|
| 282 | #endif |
---|
| 283 | {"japanese-sjis", "shiftjis"}, |
---|
| 284 | {"japanese-ujis", "euc-jp"}, |
---|
| 285 | {"japanese.euc", "euc-jp"}, |
---|
| 286 | {"japanese.sjis", "shiftjis"}, |
---|
| 287 | {"jis0201", "jis0201"}, |
---|
| 288 | {"jis0208", "jis0208"}, |
---|
| 289 | {"jis0212", "jis0212"}, |
---|
| 290 | {"jp_jp", "shiftjis"}, |
---|
| 291 | {"ko", "euc-kr"}, |
---|
| 292 | {"ko_kr", "euc-kr"}, |
---|
| 293 | {"ko_kr.euc", "euc-kr"}, |
---|
| 294 | {"ko_kw.euckw", "euc-kr"}, |
---|
| 295 | {"koi8-r", "koi8-r"}, |
---|
| 296 | {"koi8-u", "koi8-u"}, |
---|
| 297 | {"korean", "euc-kr"}, |
---|
| 298 | {"ksc5601", "ksc5601"}, |
---|
| 299 | {"maccenteuro", "macCentEuro"}, |
---|
| 300 | {"maccroatian", "macCroatian"}, |
---|
| 301 | {"maccyrillic", "macCyrillic"}, |
---|
| 302 | {"macdingbats", "macDingbats"}, |
---|
| 303 | {"macgreek", "macGreek"}, |
---|
| 304 | {"maciceland", "macIceland"}, |
---|
| 305 | {"macjapan", "macJapan"}, |
---|
| 306 | {"macroman", "macRoman"}, |
---|
| 307 | {"macromania", "macRomania"}, |
---|
| 308 | {"macthai", "macThai"}, |
---|
| 309 | {"macturkish", "macTurkish"}, |
---|
| 310 | {"macukraine", "macUkraine"}, |
---|
| 311 | {"roman8", "iso8859-1"}, |
---|
| 312 | {"ru", "iso8859-5"}, |
---|
| 313 | {"ru_ru", "iso8859-5"}, |
---|
| 314 | {"ru_su", "iso8859-5"}, |
---|
| 315 | {"shiftjis", "shiftjis"}, |
---|
| 316 | {"sjis", "shiftjis"}, |
---|
| 317 | {"symbol", "symbol"}, |
---|
| 318 | {"tis-620", "tis-620"}, |
---|
| 319 | {"tis620", "tis-620"}, |
---|
| 320 | {"turkish8", "cp857"}, |
---|
| 321 | {"utf8", "utf-8"}, |
---|
| 322 | {"zh", "cp936"}, |
---|
| 323 | {"zh_cn.gb2312", "euc-cn"}, |
---|
| 324 | {"zh_cn.gbk", "euc-cn"}, |
---|
| 325 | {"zh_cz.gb2312", "euc-cn"}, |
---|
| 326 | {"zh_tw", "euc-tw"}, |
---|
| 327 | {"zh_tw.big5", "big5"}, |
---|
| 328 | }; |
---|
| 329 | |
---|
| 330 | #ifndef TCL_NO_STACK_CHECK |
---|
| 331 | static int GetStackSize(size_t *stackSizePtr); |
---|
| 332 | #endif /* TCL_NO_STACK_CHECK */ |
---|
| 333 | #ifdef HAVE_COREFOUNDATION |
---|
| 334 | static int MacOSXGetLibraryPath(Tcl_Interp *interp, |
---|
| 335 | int maxPathLen, char *tclLibPath); |
---|
| 336 | #endif /* HAVE_COREFOUNDATION */ |
---|
| 337 | #if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \ |
---|
| 338 | defined(TCL_THREADS) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ |
---|
| 339 | MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || ( \ |
---|
| 340 | defined(__LP64__) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ |
---|
| 341 | MAC_OS_X_VERSION_MIN_REQUIRED < 1050)) |
---|
| 342 | /* |
---|
| 343 | * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: |
---|
| 344 | * initialize release global at startup from uname(). |
---|
| 345 | */ |
---|
| 346 | #define GET_DARWIN_RELEASE 1 |
---|
| 347 | MODULE_SCOPE long tclMacOSXDarwinRelease; |
---|
| 348 | long tclMacOSXDarwinRelease = 0; |
---|
| 349 | #endif |
---|
| 350 | |
---|
| 351 | |
---|
| 352 | /* |
---|
| 353 | *--------------------------------------------------------------------------- |
---|
| 354 | * |
---|
| 355 | * TclpInitPlatform -- |
---|
| 356 | * |
---|
| 357 | * Initialize all the platform-dependant things like signals and |
---|
| 358 | * floating-point error handling. |
---|
| 359 | * |
---|
| 360 | * Called at process initialization time. |
---|
| 361 | * |
---|
| 362 | * Results: |
---|
| 363 | * None. |
---|
| 364 | * |
---|
| 365 | * Side effects: |
---|
| 366 | * None. |
---|
| 367 | * |
---|
| 368 | *--------------------------------------------------------------------------- |
---|
| 369 | */ |
---|
| 370 | |
---|
| 371 | void |
---|
| 372 | TclpInitPlatform(void) |
---|
| 373 | { |
---|
| 374 | #ifdef DJGPP |
---|
| 375 | tclPlatform = TCL_PLATFORM_WINDOWS; |
---|
| 376 | #else |
---|
| 377 | tclPlatform = TCL_PLATFORM_UNIX; |
---|
| 378 | #endif |
---|
| 379 | |
---|
| 380 | /* |
---|
| 381 | * Make sure, that the standard FDs exist. [Bug 772288] |
---|
| 382 | */ |
---|
| 383 | |
---|
| 384 | if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { |
---|
| 385 | open("/dev/null", O_RDONLY); |
---|
| 386 | } |
---|
| 387 | if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { |
---|
| 388 | open("/dev/null", O_WRONLY); |
---|
| 389 | } |
---|
| 390 | if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { |
---|
| 391 | open("/dev/null", O_WRONLY); |
---|
| 392 | } |
---|
| 393 | |
---|
| 394 | /* |
---|
| 395 | * The code below causes SIGPIPE (broken pipe) errors to be ignored. This |
---|
| 396 | * is needed so that Tcl processes don't die if they create child |
---|
| 397 | * processes (e.g. using "exec" or "open") that terminate prematurely. |
---|
| 398 | * The signal handler is only set up when the first interpreter is |
---|
| 399 | * created; after this the application can override the handler with a |
---|
| 400 | * different one of its own, if it wants. |
---|
| 401 | */ |
---|
| 402 | |
---|
| 403 | #ifdef SIGPIPE |
---|
| 404 | (void) signal(SIGPIPE, SIG_IGN); |
---|
| 405 | #endif /* SIGPIPE */ |
---|
| 406 | |
---|
| 407 | #if defined(__FreeBSD__) && defined(__GNUC__) |
---|
| 408 | /* |
---|
| 409 | * Adjust the rounding mode to be more conventional. Note that FreeBSD |
---|
| 410 | * only provides the __fpsetreg() used by the following two for the GNU |
---|
| 411 | * Compiler. When using, say, Intel's icc they break. (Partially based on |
---|
| 412 | * patch in BSD ports system from root@celsius.bychok.com) |
---|
| 413 | */ |
---|
| 414 | |
---|
| 415 | fpsetround(FP_RN); |
---|
| 416 | (void) fpsetmask(0L); |
---|
| 417 | #endif |
---|
| 418 | |
---|
| 419 | #if defined(__bsdi__) && (_BSDI_VERSION > 199501) |
---|
| 420 | /* |
---|
| 421 | * Find local symbols. Don't report an error if we fail. |
---|
| 422 | */ |
---|
| 423 | |
---|
| 424 | (void) dlopen(NULL, RTLD_NOW); /* INTL: Native. */ |
---|
| 425 | #endif |
---|
| 426 | |
---|
| 427 | /* |
---|
| 428 | * Initialize the C library's locale subsystem. This is required for input |
---|
| 429 | * methods to work properly on X11. We only do this for LC_CTYPE because |
---|
| 430 | * that's the necessary one, and we don't want to affect LC_TIME here. |
---|
| 431 | * The side effect of setting the default locale should be to load any |
---|
| 432 | * locale specific modules that are needed by X. [BUG: 5422 3345 4236 2522 |
---|
| 433 | * 2521]. |
---|
| 434 | */ |
---|
| 435 | |
---|
| 436 | setlocale(LC_CTYPE, ""); |
---|
| 437 | |
---|
| 438 | /* |
---|
| 439 | * In case the initial locale is not "C", ensure that the numeric |
---|
| 440 | * processing is done in "C" locale regardless. This is needed because Tcl |
---|
| 441 | * relies on routines like strtod, but should not have locale dependent |
---|
| 442 | * behavior. |
---|
| 443 | */ |
---|
| 444 | |
---|
| 445 | setlocale(LC_NUMERIC, "C"); |
---|
| 446 | |
---|
| 447 | #ifdef GET_DARWIN_RELEASE |
---|
| 448 | { |
---|
| 449 | struct utsname name; |
---|
| 450 | |
---|
| 451 | if (!uname(&name)) { |
---|
| 452 | tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); |
---|
| 453 | } |
---|
| 454 | } |
---|
| 455 | #endif |
---|
| 456 | } |
---|
| 457 | |
---|
| 458 | /* |
---|
| 459 | *--------------------------------------------------------------------------- |
---|
| 460 | * |
---|
| 461 | * TclpInitLibraryPath -- |
---|
| 462 | * |
---|
| 463 | * This is the fallback routine that sets the library path if the |
---|
| 464 | * application has not set one by the first time it is needed. |
---|
| 465 | * |
---|
| 466 | * Results: |
---|
| 467 | * None. |
---|
| 468 | * |
---|
| 469 | * Side effects: |
---|
| 470 | * Sets the library path to an initial value. |
---|
| 471 | * |
---|
| 472 | *------------------------------------------------------------------------- |
---|
| 473 | */ |
---|
| 474 | |
---|
| 475 | void |
---|
| 476 | TclpInitLibraryPath( |
---|
| 477 | char **valuePtr, |
---|
| 478 | int *lengthPtr, |
---|
| 479 | Tcl_Encoding *encodingPtr) |
---|
| 480 | { |
---|
| 481 | #define LIBRARY_SIZE 32 |
---|
| 482 | Tcl_Obj *pathPtr, *objPtr; |
---|
| 483 | CONST char *str; |
---|
| 484 | Tcl_DString buffer; |
---|
| 485 | |
---|
| 486 | pathPtr = Tcl_NewObj(); |
---|
| 487 | |
---|
| 488 | /* |
---|
| 489 | * Look for the library relative to the TCL_LIBRARY env variable. If the |
---|
| 490 | * last dirname in the TCL_LIBRARY path does not match the last dirname in |
---|
| 491 | * the installLib variable, use the last dir name of installLib in |
---|
| 492 | * addition to the orginal TCL_LIBRARY path. |
---|
| 493 | */ |
---|
| 494 | |
---|
| 495 | str = getenv("TCL_LIBRARY"); /* INTL: Native. */ |
---|
| 496 | Tcl_ExternalToUtfDString(NULL, str, -1, &buffer); |
---|
| 497 | str = Tcl_DStringValue(&buffer); |
---|
| 498 | |
---|
| 499 | if ((str != NULL) && (str[0] != '\0')) { |
---|
| 500 | Tcl_DString ds; |
---|
| 501 | int pathc; |
---|
| 502 | CONST char **pathv; |
---|
| 503 | char installLib[LIBRARY_SIZE]; |
---|
| 504 | |
---|
| 505 | Tcl_DStringInit(&ds); |
---|
| 506 | |
---|
| 507 | /* |
---|
| 508 | * Initialize the substrings used when locating an executable. The |
---|
| 509 | * installLib variable computes the path as though the executable is |
---|
| 510 | * installed. |
---|
| 511 | */ |
---|
| 512 | |
---|
| 513 | sprintf(installLib, "lib/tcl%s", TCL_VERSION); |
---|
| 514 | |
---|
| 515 | /* |
---|
| 516 | * If TCL_LIBRARY is set, search there. |
---|
| 517 | */ |
---|
| 518 | |
---|
| 519 | objPtr = Tcl_NewStringObj(str, -1); |
---|
| 520 | Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
---|
| 521 | |
---|
| 522 | Tcl_SplitPath(str, &pathc, &pathv); |
---|
| 523 | if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { |
---|
| 524 | /* |
---|
| 525 | * If TCL_LIBRARY is set but refers to a different tcl |
---|
| 526 | * installation than the current version, try fiddling with the |
---|
| 527 | * specified directory to make it refer to this installation by |
---|
| 528 | * removing the old "tclX.Y" and substituting the current version |
---|
| 529 | * string. |
---|
| 530 | */ |
---|
| 531 | |
---|
| 532 | pathv[pathc - 1] = installLib + 4; |
---|
| 533 | str = Tcl_JoinPath(pathc, pathv, &ds); |
---|
| 534 | objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); |
---|
| 535 | Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
---|
| 536 | Tcl_DStringFree(&ds); |
---|
| 537 | } |
---|
| 538 | ckfree((char *) pathv); |
---|
| 539 | } |
---|
| 540 | |
---|
| 541 | /* |
---|
| 542 | * Finally, look for the library relative to the compiled-in path. This is |
---|
| 543 | * needed when users install Tcl with an exec-prefix that is different |
---|
| 544 | * from the prefix. |
---|
| 545 | */ |
---|
| 546 | |
---|
| 547 | { |
---|
| 548 | #ifdef HAVE_COREFOUNDATION |
---|
| 549 | char tclLibPath[MAXPATHLEN + 1]; |
---|
| 550 | |
---|
| 551 | if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { |
---|
| 552 | str = tclLibPath; |
---|
| 553 | } else |
---|
| 554 | #endif /* HAVE_COREFOUNDATION */ |
---|
| 555 | { |
---|
| 556 | /* |
---|
| 557 | * TODO: Pull this value from the TIP 59 table. |
---|
| 558 | */ |
---|
| 559 | |
---|
| 560 | str = defaultLibraryDir; |
---|
| 561 | } |
---|
| 562 | if (str[0] != '\0') { |
---|
| 563 | objPtr = Tcl_NewStringObj(str, -1); |
---|
| 564 | Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
---|
| 565 | } |
---|
| 566 | } |
---|
| 567 | Tcl_DStringFree(&buffer); |
---|
| 568 | |
---|
| 569 | *encodingPtr = Tcl_GetEncoding(NULL, NULL); |
---|
| 570 | str = Tcl_GetStringFromObj(pathPtr, lengthPtr); |
---|
| 571 | *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); |
---|
| 572 | memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1); |
---|
| 573 | Tcl_DecrRefCount(pathPtr); |
---|
| 574 | } |
---|
| 575 | |
---|
| 576 | /* |
---|
| 577 | *--------------------------------------------------------------------------- |
---|
| 578 | * |
---|
| 579 | * TclpSetInitialEncodings -- |
---|
| 580 | * |
---|
| 581 | * Based on the locale, determine the encoding of the operating system |
---|
| 582 | * and the default encoding for newly opened files. |
---|
| 583 | * |
---|
| 584 | * Called at process initialization time, and part way through startup, |
---|
| 585 | * we verify that the initial encodings were correctly setup. Depending |
---|
| 586 | * on Tcl's environment, there may not have been enough information first |
---|
| 587 | * time through (above). |
---|
| 588 | * |
---|
| 589 | * Results: |
---|
| 590 | * None. |
---|
| 591 | * |
---|
| 592 | * Side effects: |
---|
| 593 | * The Tcl library path is converted from native encoding to UTF-8, on |
---|
| 594 | * the first call, and the encodings may be changed on first or second |
---|
| 595 | * call. |
---|
| 596 | * |
---|
| 597 | *--------------------------------------------------------------------------- |
---|
| 598 | */ |
---|
| 599 | |
---|
| 600 | void |
---|
| 601 | TclpSetInitialEncodings(void) |
---|
| 602 | { |
---|
| 603 | Tcl_DString encodingName; |
---|
| 604 | Tcl_SetSystemEncoding(NULL, |
---|
| 605 | Tcl_GetEncodingNameFromEnvironment(&encodingName)); |
---|
| 606 | Tcl_DStringFree(&encodingName); |
---|
| 607 | } |
---|
| 608 | |
---|
| 609 | void |
---|
| 610 | TclpSetInterfaces(void) |
---|
| 611 | { |
---|
| 612 | /* do nothing */ |
---|
| 613 | } |
---|
| 614 | |
---|
| 615 | static CONST char * |
---|
| 616 | SearchKnownEncodings( |
---|
| 617 | CONST char *encoding) |
---|
| 618 | { |
---|
| 619 | int left = 0; |
---|
| 620 | int right = sizeof(localeTable)/sizeof(LocaleTable); |
---|
| 621 | |
---|
| 622 | while (left <= right) { |
---|
| 623 | int test = (left + right)/2; |
---|
| 624 | int code = strcmp(localeTable[test].lang, encoding); |
---|
| 625 | |
---|
| 626 | if (code == 0) { |
---|
| 627 | return localeTable[test].encoding; |
---|
| 628 | } |
---|
| 629 | if (code < 0) { |
---|
| 630 | left = test+1; |
---|
| 631 | } else { |
---|
| 632 | right = test-1; |
---|
| 633 | } |
---|
| 634 | } |
---|
| 635 | return NULL; |
---|
| 636 | } |
---|
| 637 | |
---|
| 638 | CONST char * |
---|
| 639 | Tcl_GetEncodingNameFromEnvironment( |
---|
| 640 | Tcl_DString *bufPtr) |
---|
| 641 | { |
---|
| 642 | CONST char *encoding; |
---|
| 643 | CONST char *knownEncoding; |
---|
| 644 | |
---|
| 645 | Tcl_DStringInit(bufPtr); |
---|
| 646 | |
---|
| 647 | /* |
---|
| 648 | * Determine the current encoding from the LC_* or LANG environment |
---|
| 649 | * variables. We previously used setlocale() to determine the locale, but |
---|
| 650 | * this does not work on some systems (e.g. Linux/i386 RH 5.0). |
---|
| 651 | */ |
---|
| 652 | |
---|
| 653 | #ifdef HAVE_LANGINFO |
---|
| 654 | if ( |
---|
| 655 | #ifdef WEAK_IMPORT_NL_LANGINFO |
---|
| 656 | nl_langinfo != NULL && |
---|
| 657 | #endif |
---|
| 658 | setlocale(LC_CTYPE, "") != NULL) { |
---|
| 659 | Tcl_DString ds; |
---|
| 660 | |
---|
| 661 | /* |
---|
| 662 | * Use a DString so we can modify case. |
---|
| 663 | */ |
---|
| 664 | |
---|
| 665 | Tcl_DStringInit(&ds); |
---|
| 666 | encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); |
---|
| 667 | Tcl_UtfToLower(Tcl_DStringValue(&ds)); |
---|
| 668 | knownEncoding = SearchKnownEncodings(encoding); |
---|
| 669 | if (knownEncoding != NULL) { |
---|
| 670 | Tcl_DStringAppend(bufPtr, knownEncoding, -1); |
---|
| 671 | } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { |
---|
| 672 | Tcl_DStringAppend(bufPtr, encoding, -1); |
---|
| 673 | } |
---|
| 674 | Tcl_DStringFree(&ds); |
---|
| 675 | if (Tcl_DStringLength(bufPtr)) { |
---|
| 676 | return Tcl_DStringValue(bufPtr); |
---|
| 677 | } |
---|
| 678 | } |
---|
| 679 | #endif /* HAVE_LANGINFO */ |
---|
| 680 | |
---|
| 681 | /* |
---|
| 682 | * Classic fallback check. This tries a homebrew algorithm to determine |
---|
| 683 | * what encoding should be used based on env vars. |
---|
| 684 | */ |
---|
| 685 | |
---|
| 686 | encoding = getenv("LC_ALL"); |
---|
| 687 | |
---|
| 688 | if (encoding == NULL || encoding[0] == '\0') { |
---|
| 689 | encoding = getenv("LC_CTYPE"); |
---|
| 690 | } |
---|
| 691 | if (encoding == NULL || encoding[0] == '\0') { |
---|
| 692 | encoding = getenv("LANG"); |
---|
| 693 | } |
---|
| 694 | if (encoding == NULL || encoding[0] == '\0') { |
---|
| 695 | encoding = NULL; |
---|
| 696 | } |
---|
| 697 | |
---|
| 698 | if (encoding != NULL) { |
---|
| 699 | CONST char *p; |
---|
| 700 | Tcl_DString ds; |
---|
| 701 | |
---|
| 702 | Tcl_DStringInit(&ds); |
---|
| 703 | p = encoding; |
---|
| 704 | encoding = Tcl_DStringAppend(&ds, p, -1); |
---|
| 705 | Tcl_UtfToLower(Tcl_DStringValue(&ds)); |
---|
| 706 | |
---|
| 707 | knownEncoding = SearchKnownEncodings(encoding); |
---|
| 708 | if (knownEncoding != NULL) { |
---|
| 709 | Tcl_DStringAppend(bufPtr, knownEncoding, -1); |
---|
| 710 | } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { |
---|
| 711 | Tcl_DStringAppend(bufPtr, encoding, -1); |
---|
| 712 | } |
---|
| 713 | if (Tcl_DStringLength(bufPtr)) { |
---|
| 714 | Tcl_DStringFree(&ds); |
---|
| 715 | return Tcl_DStringValue(bufPtr); |
---|
| 716 | } |
---|
| 717 | |
---|
| 718 | /* |
---|
| 719 | * We didn't recognize the full value as an encoding name. If there is |
---|
| 720 | * an encoding subfield, we can try to guess from that. |
---|
| 721 | */ |
---|
| 722 | |
---|
| 723 | for (p = encoding; *p != '\0'; p++) { |
---|
| 724 | if (*p == '.') { |
---|
| 725 | p++; |
---|
| 726 | break; |
---|
| 727 | } |
---|
| 728 | } |
---|
| 729 | if (*p != '\0') { |
---|
| 730 | knownEncoding = SearchKnownEncodings(p); |
---|
| 731 | if (knownEncoding != NULL) { |
---|
| 732 | Tcl_DStringAppend(bufPtr, knownEncoding, -1); |
---|
| 733 | } else if (NULL != Tcl_GetEncoding(NULL, p)) { |
---|
| 734 | Tcl_DStringAppend(bufPtr, p, -1); |
---|
| 735 | } |
---|
| 736 | } |
---|
| 737 | Tcl_DStringFree(&ds); |
---|
| 738 | if (Tcl_DStringLength(bufPtr)) { |
---|
| 739 | return Tcl_DStringValue(bufPtr); |
---|
| 740 | } |
---|
| 741 | } |
---|
| 742 | return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1); |
---|
| 743 | } |
---|
| 744 | |
---|
| 745 | /* |
---|
| 746 | *--------------------------------------------------------------------------- |
---|
| 747 | * |
---|
| 748 | * TclpSetVariables -- |
---|
| 749 | * |
---|
| 750 | * Performs platform-specific interpreter initialization related to the |
---|
| 751 | * tcl_library and tcl_platform variables, and other platform-specific |
---|
| 752 | * things. |
---|
| 753 | * |
---|
| 754 | * Results: |
---|
| 755 | * None. |
---|
| 756 | * |
---|
| 757 | * Side effects: |
---|
| 758 | * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl |
---|
| 759 | * variables. |
---|
| 760 | * |
---|
| 761 | *---------------------------------------------------------------------- |
---|
| 762 | */ |
---|
| 763 | |
---|
| 764 | void |
---|
| 765 | TclpSetVariables( |
---|
| 766 | Tcl_Interp *interp) |
---|
| 767 | { |
---|
| 768 | #ifndef NO_UNAME |
---|
| 769 | struct utsname name; |
---|
| 770 | #endif |
---|
| 771 | int unameOK; |
---|
| 772 | Tcl_DString ds; |
---|
| 773 | |
---|
| 774 | #ifdef HAVE_COREFOUNDATION |
---|
| 775 | char tclLibPath[MAXPATHLEN + 1]; |
---|
| 776 | |
---|
| 777 | #if MAC_OS_X_VERSION_MAX_ALLOWED > 1020 |
---|
| 778 | /* |
---|
| 779 | * Set msgcat fallback locale to current CFLocale identifier. |
---|
| 780 | */ |
---|
| 781 | |
---|
| 782 | CFLocaleRef localeRef; |
---|
| 783 | |
---|
| 784 | if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && |
---|
| 785 | (localeRef = CFLocaleCopyCurrent())) { |
---|
| 786 | CFStringRef locale = CFLocaleGetIdentifier(localeRef); |
---|
| 787 | |
---|
| 788 | if (locale) { |
---|
| 789 | char loc[256]; |
---|
| 790 | |
---|
| 791 | if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) { |
---|
| 792 | if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { |
---|
| 793 | Tcl_ResetResult(interp); |
---|
| 794 | } |
---|
| 795 | Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); |
---|
| 796 | } |
---|
| 797 | } |
---|
| 798 | CFRelease(localeRef); |
---|
| 799 | } |
---|
| 800 | #endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */ |
---|
| 801 | |
---|
| 802 | if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { |
---|
| 803 | CONST char *str; |
---|
| 804 | CFBundleRef bundleRef; |
---|
| 805 | |
---|
| 806 | Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); |
---|
| 807 | Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY); |
---|
| 808 | Tcl_SetVar(interp, "tcl_pkgPath", " ", |
---|
| 809 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 810 | |
---|
| 811 | str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); |
---|
| 812 | if ((str != NULL) && (str[0] != '\0')) { |
---|
| 813 | char *p = Tcl_DStringValue(&ds); |
---|
| 814 | |
---|
| 815 | /* |
---|
| 816 | * Convert DYLD_FRAMEWORK_PATH from colon to space separated. |
---|
| 817 | */ |
---|
| 818 | |
---|
| 819 | do { |
---|
| 820 | if (*p == ':') { |
---|
| 821 | *p = ' '; |
---|
| 822 | } |
---|
| 823 | } while (*p++); |
---|
| 824 | Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), |
---|
| 825 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 826 | Tcl_SetVar(interp, "tcl_pkgPath", " ", |
---|
| 827 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 828 | Tcl_DStringFree(&ds); |
---|
| 829 | } |
---|
| 830 | bundleRef = CFBundleGetMainBundle(); |
---|
| 831 | if (bundleRef) { |
---|
| 832 | CFURLRef frameworksURL; |
---|
| 833 | Tcl_StatBuf statBuf; |
---|
| 834 | |
---|
| 835 | frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef); |
---|
| 836 | if (frameworksURL) { |
---|
| 837 | if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, |
---|
| 838 | (unsigned char*) tclLibPath, MAXPATHLEN) && |
---|
| 839 | ! TclOSstat(tclLibPath, &statBuf) && |
---|
| 840 | S_ISDIR(statBuf.st_mode)) { |
---|
| 841 | Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, |
---|
| 842 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 843 | Tcl_SetVar(interp, "tcl_pkgPath", " ", |
---|
| 844 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 845 | } |
---|
| 846 | CFRelease(frameworksURL); |
---|
| 847 | } |
---|
| 848 | frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef); |
---|
| 849 | if (frameworksURL) { |
---|
| 850 | if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, |
---|
| 851 | (unsigned char*) tclLibPath, MAXPATHLEN) && |
---|
| 852 | ! TclOSstat(tclLibPath, &statBuf) && |
---|
| 853 | S_ISDIR(statBuf.st_mode)) { |
---|
| 854 | Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, |
---|
| 855 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 856 | Tcl_SetVar(interp, "tcl_pkgPath", " ", |
---|
| 857 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 858 | } |
---|
| 859 | CFRelease(frameworksURL); |
---|
| 860 | } |
---|
| 861 | } |
---|
| 862 | Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, |
---|
| 863 | TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); |
---|
| 864 | } else |
---|
| 865 | #endif /* HAVE_COREFOUNDATION */ |
---|
| 866 | { |
---|
| 867 | Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); |
---|
| 868 | } |
---|
| 869 | |
---|
| 870 | #ifdef DJGPP |
---|
| 871 | Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); |
---|
| 872 | #else |
---|
| 873 | Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); |
---|
| 874 | #endif |
---|
| 875 | |
---|
| 876 | unameOK = 0; |
---|
| 877 | #ifndef NO_UNAME |
---|
| 878 | if (uname(&name) >= 0) { |
---|
| 879 | CONST char *native; |
---|
| 880 | |
---|
| 881 | unameOK = 1; |
---|
| 882 | |
---|
| 883 | native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds); |
---|
| 884 | Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY); |
---|
| 885 | Tcl_DStringFree(&ds); |
---|
| 886 | |
---|
| 887 | /* |
---|
| 888 | * The following code is a special hack to handle differences in the |
---|
| 889 | * way version information is returned by uname. On most systems the |
---|
| 890 | * full version number is available in name.release. However, under |
---|
| 891 | * AIX the major version number is in name.version and the minor |
---|
| 892 | * version number is in name.release. |
---|
| 893 | */ |
---|
| 894 | |
---|
| 895 | if ((strchr(name.release, '.') != NULL) |
---|
| 896 | || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */ |
---|
| 897 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, |
---|
| 898 | TCL_GLOBAL_ONLY); |
---|
| 899 | } else { |
---|
| 900 | #ifdef DJGPP |
---|
| 901 | /* |
---|
| 902 | * For some obscure reason DJGPP puts major version into |
---|
| 903 | * name.release and minor into name.version. As of DJGPP 2.04 this |
---|
| 904 | * is documented in djgpp libc.info file. |
---|
| 905 | */ |
---|
| 906 | |
---|
| 907 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, |
---|
| 908 | TCL_GLOBAL_ONLY); |
---|
| 909 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", |
---|
| 910 | TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); |
---|
| 911 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, |
---|
| 912 | TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); |
---|
| 913 | #else |
---|
| 914 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, |
---|
| 915 | TCL_GLOBAL_ONLY); |
---|
| 916 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", |
---|
| 917 | TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); |
---|
| 918 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, |
---|
| 919 | TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); |
---|
| 920 | |
---|
| 921 | #endif /* DJGPP */ |
---|
| 922 | } |
---|
| 923 | Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, |
---|
| 924 | TCL_GLOBAL_ONLY); |
---|
| 925 | } |
---|
| 926 | #endif /* !NO_UNAME */ |
---|
| 927 | if (!unameOK) { |
---|
| 928 | Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); |
---|
| 929 | Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); |
---|
| 930 | Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); |
---|
| 931 | } |
---|
| 932 | |
---|
| 933 | /* |
---|
| 934 | * Copy the username of the real user (according to getuid()) into |
---|
| 935 | * tcl_platform(user). |
---|
| 936 | */ |
---|
| 937 | |
---|
| 938 | { |
---|
| 939 | struct passwd *pwEnt = TclpGetPwUid(getuid()); |
---|
| 940 | const char *user; |
---|
| 941 | |
---|
| 942 | if (pwEnt == NULL) { |
---|
| 943 | user = ""; |
---|
| 944 | Tcl_DStringInit(&ds); /* ensure cleanliness */ |
---|
| 945 | } else { |
---|
| 946 | user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds); |
---|
| 947 | } |
---|
| 948 | |
---|
| 949 | Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); |
---|
| 950 | Tcl_DStringFree(&ds); |
---|
| 951 | } |
---|
| 952 | } |
---|
| 953 | |
---|
| 954 | /* |
---|
| 955 | *---------------------------------------------------------------------- |
---|
| 956 | * |
---|
| 957 | * TclpFindVariable -- |
---|
| 958 | * |
---|
| 959 | * Locate the entry in environ for a given name. On Unix this routine is |
---|
| 960 | * case sensetive, on Windows this matches mixed case. |
---|
| 961 | * |
---|
| 962 | * Results: |
---|
| 963 | * The return value is the index in environ of an entry with the name |
---|
| 964 | * "name", or -1 if there is no such entry. The integer at *lengthPtr is |
---|
| 965 | * filled in with the length of name (if a matching entry is found) or |
---|
| 966 | * the length of the environ array (if no matching entry is found). |
---|
| 967 | * |
---|
| 968 | * Side effects: |
---|
| 969 | * None. |
---|
| 970 | * |
---|
| 971 | *---------------------------------------------------------------------- |
---|
| 972 | */ |
---|
| 973 | |
---|
| 974 | int |
---|
| 975 | TclpFindVariable( |
---|
| 976 | CONST char *name, /* Name of desired environment variable |
---|
| 977 | * (native). */ |
---|
| 978 | int *lengthPtr) /* Used to return length of name (for |
---|
| 979 | * successful searches) or number of non-NULL |
---|
| 980 | * entries in environ (for unsuccessful |
---|
| 981 | * searches). */ |
---|
| 982 | { |
---|
| 983 | int i, result = -1; |
---|
| 984 | register CONST char *env, *p1, *p2; |
---|
| 985 | Tcl_DString envString; |
---|
| 986 | |
---|
| 987 | Tcl_DStringInit(&envString); |
---|
| 988 | for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { |
---|
| 989 | p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); |
---|
| 990 | p2 = name; |
---|
| 991 | |
---|
| 992 | for (; *p2 == *p1; p1++, p2++) { |
---|
| 993 | /* NULL loop body. */ |
---|
| 994 | } |
---|
| 995 | if ((*p1 == '=') && (*p2 == '\0')) { |
---|
| 996 | *lengthPtr = p2 - name; |
---|
| 997 | result = i; |
---|
| 998 | goto done; |
---|
| 999 | } |
---|
| 1000 | |
---|
| 1001 | Tcl_DStringFree(&envString); |
---|
| 1002 | } |
---|
| 1003 | |
---|
| 1004 | *lengthPtr = i; |
---|
| 1005 | |
---|
| 1006 | done: |
---|
| 1007 | Tcl_DStringFree(&envString); |
---|
| 1008 | return result; |
---|
| 1009 | } |
---|
| 1010 | |
---|
| 1011 | #ifndef TCL_NO_STACK_CHECK |
---|
| 1012 | /* |
---|
| 1013 | *---------------------------------------------------------------------- |
---|
| 1014 | * |
---|
| 1015 | * TclpGetCStackParams -- |
---|
| 1016 | * |
---|
| 1017 | * Determine the stack params for the current thread: in which |
---|
| 1018 | * direction does the stack grow, and what is the stack lower (resp. |
---|
| 1019 | * upper) bound for safe invocation of a new command? This is used to |
---|
| 1020 | * cache the values needed for an efficient computation of |
---|
| 1021 | * TclpCheckStackSpace() when the interp is known. |
---|
| 1022 | * |
---|
| 1023 | * Results: |
---|
| 1024 | * Returns 1 if the stack grows down, in which case a stack lower bound |
---|
| 1025 | * is stored at stackBoundPtr. If the stack grows up, 0 is returned and |
---|
| 1026 | * an upper bound is stored at stackBoundPtr. If a bound cannot be |
---|
| 1027 | * determined NULL is stored at stackBoundPtr. |
---|
| 1028 | * |
---|
| 1029 | *---------------------------------------------------------------------- |
---|
| 1030 | */ |
---|
| 1031 | |
---|
| 1032 | int |
---|
| 1033 | TclpGetCStackParams( |
---|
| 1034 | int **stackBoundPtr) |
---|
| 1035 | { |
---|
| 1036 | int result = TCL_OK; |
---|
| 1037 | size_t stackSize = 0; /* The size of the current stack. */ |
---|
| 1038 | ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); |
---|
| 1039 | /* Most variables are actually in a |
---|
| 1040 | * thread-specific data block to minimise the |
---|
| 1041 | * impact on the stack. */ |
---|
| 1042 | #ifdef TCL_CROSS_COMPILE |
---|
| 1043 | if (stackGrowsDown == -1) { |
---|
| 1044 | /* |
---|
| 1045 | * Not initialised! |
---|
| 1046 | */ |
---|
| 1047 | |
---|
| 1048 | stackGrowsDown = StackGrowsDown(&result); |
---|
| 1049 | } |
---|
| 1050 | #endif |
---|
| 1051 | |
---|
| 1052 | /* |
---|
| 1053 | * The first time through in a thread: record the "outermost" stack |
---|
| 1054 | * frame and inquire with the OS about the stack size. |
---|
| 1055 | */ |
---|
| 1056 | |
---|
| 1057 | if (tsdPtr->outerVarPtr == NULL) { |
---|
| 1058 | tsdPtr->outerVarPtr = &result; |
---|
| 1059 | result = GetStackSize(&stackSize); |
---|
| 1060 | if (result != TCL_OK) { |
---|
| 1061 | /* Can't check, assume it always succeeds */ |
---|
| 1062 | #ifdef TCL_CROSS_COMPILE |
---|
| 1063 | stackGrowsDown = 1; |
---|
| 1064 | #endif |
---|
| 1065 | tsdPtr->stackBound = NULL; |
---|
| 1066 | goto done; |
---|
| 1067 | } |
---|
| 1068 | } |
---|
| 1069 | |
---|
| 1070 | if (stackSize || (tsdPtr->stackBound && |
---|
| 1071 | ((stackGrowsDown && (&result < tsdPtr->stackBound)) || |
---|
| 1072 | (!stackGrowsDown && (&result > tsdPtr->stackBound))))) { |
---|
| 1073 | /* |
---|
| 1074 | * Either the thread's first pass or stack failure: set the params |
---|
| 1075 | */ |
---|
| 1076 | |
---|
| 1077 | if (!stackSize) { |
---|
| 1078 | /* |
---|
| 1079 | * Stack failure: if we didn't already blow up, we are within the |
---|
| 1080 | * safety area. Recheck with the OS in case the stack was grown. |
---|
| 1081 | */ |
---|
| 1082 | result = GetStackSize(&stackSize); |
---|
| 1083 | if (result != TCL_OK) { |
---|
| 1084 | /* Can't check, assume it always succeeds */ |
---|
| 1085 | #ifdef TCL_CROSS_COMPILE |
---|
| 1086 | stackGrowsDown = 1; |
---|
| 1087 | #endif |
---|
| 1088 | tsdPtr->stackBound = NULL; |
---|
| 1089 | goto done; |
---|
| 1090 | } |
---|
| 1091 | } |
---|
| 1092 | |
---|
| 1093 | if (stackGrowsDown) { |
---|
| 1094 | tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr - |
---|
| 1095 | stackSize); |
---|
| 1096 | } else { |
---|
| 1097 | tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr + |
---|
| 1098 | stackSize); |
---|
| 1099 | } |
---|
| 1100 | } |
---|
| 1101 | |
---|
| 1102 | done: |
---|
| 1103 | *stackBoundPtr = tsdPtr->stackBound; |
---|
| 1104 | return stackGrowsDown; |
---|
| 1105 | } |
---|
| 1106 | |
---|
| 1107 | #ifdef TCL_CROSS_COMPILE |
---|
| 1108 | int |
---|
| 1109 | StackGrowsDown( |
---|
| 1110 | int *parent) |
---|
| 1111 | { |
---|
| 1112 | int here; |
---|
| 1113 | return (&here < parent); |
---|
| 1114 | } |
---|
| 1115 | #endif |
---|
| 1116 | |
---|
| 1117 | /* |
---|
| 1118 | *---------------------------------------------------------------------- |
---|
| 1119 | * |
---|
| 1120 | * GetStackSize -- |
---|
| 1121 | * |
---|
| 1122 | * Discover what the stack size for the current thread/process actually |
---|
| 1123 | * is. Expects to only ever be called once per thread and then only at a |
---|
| 1124 | * point when there is a reasonable amount of space left on the current |
---|
| 1125 | * stack; TclpCheckStackSpace is called sufficiently frequently that that |
---|
| 1126 | * is true. |
---|
| 1127 | * |
---|
| 1128 | * Results: |
---|
| 1129 | * TCL_OK if the stack space was discovered, TCL_BREAK if the stack space |
---|
| 1130 | * was undiscoverable in a way that stack checks should fail, and |
---|
| 1131 | * TCL_CONTINUE if the stack space was undiscoverable in a way that stack |
---|
| 1132 | * checks should succeed. |
---|
| 1133 | * |
---|
| 1134 | * Side effects: |
---|
| 1135 | * None |
---|
| 1136 | * |
---|
| 1137 | *---------------------------------------------------------------------- |
---|
| 1138 | */ |
---|
| 1139 | |
---|
| 1140 | static int |
---|
| 1141 | GetStackSize( |
---|
| 1142 | size_t *stackSizePtr) |
---|
| 1143 | { |
---|
| 1144 | size_t rawStackSize; |
---|
| 1145 | struct rlimit rLimit; /* The result from getrlimit(). */ |
---|
| 1146 | |
---|
| 1147 | #ifdef TCL_THREADS |
---|
| 1148 | rawStackSize = TclpThreadGetStackSize(); |
---|
| 1149 | if (rawStackSize == (size_t) -1) { |
---|
| 1150 | /* |
---|
| 1151 | * Some kind of confirmed error in TclpThreadGetStackSize?! Fall back |
---|
| 1152 | * to whatever getrlimit can determine. |
---|
| 1153 | */ |
---|
| 1154 | STACK_DEBUG(("stack checks: TclpThreadGetStackSize failed in \n")); |
---|
| 1155 | } |
---|
| 1156 | if (rawStackSize > 0) { |
---|
| 1157 | goto finalSanityCheck; |
---|
| 1158 | } |
---|
| 1159 | |
---|
| 1160 | /* |
---|
| 1161 | * If we have zero or an error, try the system limits instead. After all, |
---|
| 1162 | * the pthread documentation states that threads should always be bound by |
---|
| 1163 | * the system stack size limit in any case. |
---|
| 1164 | */ |
---|
| 1165 | #endif /* TCL_THREADS */ |
---|
| 1166 | |
---|
| 1167 | if (getrlimit(RLIMIT_STACK, &rLimit) != 0) { |
---|
| 1168 | /* |
---|
| 1169 | * getrlimit() failed, just fail the whole thing. |
---|
| 1170 | */ |
---|
| 1171 | STACK_DEBUG(("skipping stack checks with failure: getrlimit failed\n")); |
---|
| 1172 | return TCL_BREAK; |
---|
| 1173 | } |
---|
| 1174 | if (rLimit.rlim_cur == RLIM_INFINITY) { |
---|
| 1175 | /* |
---|
| 1176 | * Limit is "infinite"; there is no stack limit. |
---|
| 1177 | */ |
---|
| 1178 | STACK_DEBUG(("skipping stack checks with success: infinite limit\n")); |
---|
| 1179 | return TCL_CONTINUE; |
---|
| 1180 | } |
---|
| 1181 | rawStackSize = rLimit.rlim_cur; |
---|
| 1182 | |
---|
| 1183 | /* |
---|
| 1184 | * Final sanity check on the determined stack size. If we fail this, |
---|
| 1185 | * assume there are bogus values about and that we can't actually figure |
---|
| 1186 | * out what the stack size really is. |
---|
| 1187 | */ |
---|
| 1188 | |
---|
| 1189 | #ifdef TCL_THREADS /* Stop warning... */ |
---|
| 1190 | finalSanityCheck: |
---|
| 1191 | #endif |
---|
| 1192 | if (rawStackSize <= 0) { |
---|
| 1193 | STACK_DEBUG(("skipping stack checks with success\n")); |
---|
| 1194 | return TCL_CONTINUE; |
---|
| 1195 | } |
---|
| 1196 | |
---|
| 1197 | /* |
---|
| 1198 | * Calculate a stack size with a safety margin. |
---|
| 1199 | */ |
---|
| 1200 | |
---|
| 1201 | *stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR) |
---|
| 1202 | - (getpagesize() * TCL_RESERVED_STACK_PAGES); |
---|
| 1203 | |
---|
| 1204 | return TCL_OK; |
---|
| 1205 | } |
---|
| 1206 | #endif /* TCL_NO_STACK_CHECK */ |
---|
| 1207 | |
---|
| 1208 | /* |
---|
| 1209 | *---------------------------------------------------------------------- |
---|
| 1210 | * |
---|
| 1211 | * MacOSXGetLibraryPath -- |
---|
| 1212 | * |
---|
| 1213 | * If we have a bundle structure for the Tcl installation, then check |
---|
| 1214 | * there first to see if we can find the libraries there. |
---|
| 1215 | * |
---|
| 1216 | * Results: |
---|
| 1217 | * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. |
---|
| 1218 | * |
---|
| 1219 | * Side effects: |
---|
| 1220 | * Same as for Tcl_MacOSXOpenVersionedBundleResources. |
---|
| 1221 | * |
---|
| 1222 | *---------------------------------------------------------------------- |
---|
| 1223 | */ |
---|
| 1224 | |
---|
| 1225 | #ifdef HAVE_COREFOUNDATION |
---|
| 1226 | static int |
---|
| 1227 | MacOSXGetLibraryPath( |
---|
| 1228 | Tcl_Interp *interp, |
---|
| 1229 | int maxPathLen, |
---|
| 1230 | char *tclLibPath) |
---|
| 1231 | { |
---|
| 1232 | int foundInFramework = TCL_ERROR; |
---|
| 1233 | |
---|
| 1234 | #ifdef TCL_FRAMEWORK |
---|
| 1235 | foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, |
---|
| 1236 | "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, |
---|
| 1237 | tclLibPath); |
---|
| 1238 | #endif |
---|
| 1239 | |
---|
| 1240 | return foundInFramework; |
---|
| 1241 | } |
---|
| 1242 | #endif /* HAVE_COREFOUNDATION */ |
---|
| 1243 | |
---|
| 1244 | /* |
---|
| 1245 | * Local Variables: |
---|
| 1246 | * mode: c |
---|
| 1247 | * c-basic-offset: 4 |
---|
| 1248 | * fill-column: 78 |
---|
| 1249 | * End: |
---|
| 1250 | */ |
---|