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.2.1 2009/10/05 02:41:13 das 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 76typedef struct ThreadSpecificData { 77 int *outerVarPtr; /* The "outermost" stack frame pointer for 78 * this thread. */ 79 int *stackBound; /* The current stack boundary */ 80} ThreadSpecificData; 81static Tcl_ThreadDataKey dataKey; 82#ifdef TCL_CROSS_COMPILE 83static int stackGrowsDown = -1; 84static 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 113static 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 121static 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 130typedef 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 145static 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 331static int GetStackSize(size_t *stackSizePtr); 332#endif /* TCL_NO_STACK_CHECK */ 333#ifdef HAVE_COREFOUNDATION 334static 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(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \ 339 (defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \ 340 (defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \ 341 (defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\ 342 ))) 343/* 344 * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: 345 * initialize release global at startup from uname(). 346 */ 347#define GET_DARWIN_RELEASE 1 348MODULE_SCOPE long tclMacOSXDarwinRelease; 349long tclMacOSXDarwinRelease = 0; 350#endif 351 352 353/* 354 *--------------------------------------------------------------------------- 355 * 356 * TclpInitPlatform -- 357 * 358 * Initialize all the platform-dependant things like signals and 359 * floating-point error handling. 360 * 361 * Called at process initialization time. 362 * 363 * Results: 364 * None. 365 * 366 * Side effects: 367 * None. 368 * 369 *--------------------------------------------------------------------------- 370 */ 371 372void 373TclpInitPlatform(void) 374{ 375#ifdef DJGPP 376 tclPlatform = TCL_PLATFORM_WINDOWS; 377#else 378 tclPlatform = TCL_PLATFORM_UNIX; 379#endif 380 381 /* 382 * Make sure, that the standard FDs exist. [Bug 772288] 383 */ 384 385 if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { 386 open("/dev/null", O_RDONLY); 387 } 388 if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { 389 open("/dev/null", O_WRONLY); 390 } 391 if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { 392 open("/dev/null", O_WRONLY); 393 } 394 395 /* 396 * The code below causes SIGPIPE (broken pipe) errors to be ignored. This 397 * is needed so that Tcl processes don't die if they create child 398 * processes (e.g. using "exec" or "open") that terminate prematurely. 399 * The signal handler is only set up when the first interpreter is 400 * created; after this the application can override the handler with a 401 * different one of its own, if it wants. 402 */ 403 404#ifdef SIGPIPE 405 (void) signal(SIGPIPE, SIG_IGN); 406#endif /* SIGPIPE */ 407 408#if defined(__FreeBSD__) && defined(__GNUC__) 409 /* 410 * Adjust the rounding mode to be more conventional. Note that FreeBSD 411 * only provides the __fpsetreg() used by the following two for the GNU 412 * Compiler. When using, say, Intel's icc they break. (Partially based on 413 * patch in BSD ports system from root@celsius.bychok.com) 414 */ 415 416 fpsetround(FP_RN); 417 (void) fpsetmask(0L); 418#endif 419 420#if defined(__bsdi__) && (_BSDI_VERSION > 199501) 421 /* 422 * Find local symbols. Don't report an error if we fail. 423 */ 424 425 (void) dlopen(NULL, RTLD_NOW); /* INTL: Native. */ 426#endif 427 428 /* 429 * Initialize the C library's locale subsystem. This is required for input 430 * methods to work properly on X11. We only do this for LC_CTYPE because 431 * that's the necessary one, and we don't want to affect LC_TIME here. 432 * The side effect of setting the default locale should be to load any 433 * locale specific modules that are needed by X. [BUG: 5422 3345 4236 2522 434 * 2521]. 435 */ 436 437 setlocale(LC_CTYPE, ""); 438 439 /* 440 * In case the initial locale is not "C", ensure that the numeric 441 * processing is done in "C" locale regardless. This is needed because Tcl 442 * relies on routines like strtod, but should not have locale dependent 443 * behavior. 444 */ 445 446 setlocale(LC_NUMERIC, "C"); 447 448#ifdef GET_DARWIN_RELEASE 449 { 450 struct utsname name; 451 452 if (!uname(&name)) { 453 tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); 454 } 455 } 456#endif 457} 458 459/* 460 *--------------------------------------------------------------------------- 461 * 462 * TclpInitLibraryPath -- 463 * 464 * This is the fallback routine that sets the library path if the 465 * application has not set one by the first time it is needed. 466 * 467 * Results: 468 * None. 469 * 470 * Side effects: 471 * Sets the library path to an initial value. 472 * 473 *------------------------------------------------------------------------- 474 */ 475 476void 477TclpInitLibraryPath( 478 char **valuePtr, 479 int *lengthPtr, 480 Tcl_Encoding *encodingPtr) 481{ 482#define LIBRARY_SIZE 32 483 Tcl_Obj *pathPtr, *objPtr; 484 CONST char *str; 485 Tcl_DString buffer; 486 487 pathPtr = Tcl_NewObj(); 488 489 /* 490 * Look for the library relative to the TCL_LIBRARY env variable. If the 491 * last dirname in the TCL_LIBRARY path does not match the last dirname in 492 * the installLib variable, use the last dir name of installLib in 493 * addition to the orginal TCL_LIBRARY path. 494 */ 495 496 str = getenv("TCL_LIBRARY"); /* INTL: Native. */ 497 Tcl_ExternalToUtfDString(NULL, str, -1, &buffer); 498 str = Tcl_DStringValue(&buffer); 499 500 if ((str != NULL) && (str[0] != '\0')) { 501 Tcl_DString ds; 502 int pathc; 503 CONST char **pathv; 504 char installLib[LIBRARY_SIZE]; 505 506 Tcl_DStringInit(&ds); 507 508 /* 509 * Initialize the substrings used when locating an executable. The 510 * installLib variable computes the path as though the executable is 511 * installed. 512 */ 513 514 sprintf(installLib, "lib/tcl%s", TCL_VERSION); 515 516 /* 517 * If TCL_LIBRARY is set, search there. 518 */ 519 520 objPtr = Tcl_NewStringObj(str, -1); 521 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 522 523 Tcl_SplitPath(str, &pathc, &pathv); 524 if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { 525 /* 526 * If TCL_LIBRARY is set but refers to a different tcl 527 * installation than the current version, try fiddling with the 528 * specified directory to make it refer to this installation by 529 * removing the old "tclX.Y" and substituting the current version 530 * string. 531 */ 532 533 pathv[pathc - 1] = installLib + 4; 534 str = Tcl_JoinPath(pathc, pathv, &ds); 535 objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); 536 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 537 Tcl_DStringFree(&ds); 538 } 539 ckfree((char *) pathv); 540 } 541 542 /* 543 * Finally, look for the library relative to the compiled-in path. This is 544 * needed when users install Tcl with an exec-prefix that is different 545 * from the prefix. 546 */ 547 548 { 549#ifdef HAVE_COREFOUNDATION 550 char tclLibPath[MAXPATHLEN + 1]; 551 552 if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { 553 str = tclLibPath; 554 } else 555#endif /* HAVE_COREFOUNDATION */ 556 { 557 /* 558 * TODO: Pull this value from the TIP 59 table. 559 */ 560 561 str = defaultLibraryDir; 562 } 563 if (str[0] != '\0') { 564 objPtr = Tcl_NewStringObj(str, -1); 565 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 566 } 567 } 568 Tcl_DStringFree(&buffer); 569 570 *encodingPtr = Tcl_GetEncoding(NULL, NULL); 571 str = Tcl_GetStringFromObj(pathPtr, lengthPtr); 572 *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1); 573 memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1); 574 Tcl_DecrRefCount(pathPtr); 575} 576 577/* 578 *--------------------------------------------------------------------------- 579 * 580 * TclpSetInitialEncodings -- 581 * 582 * Based on the locale, determine the encoding of the operating system 583 * and the default encoding for newly opened files. 584 * 585 * Called at process initialization time, and part way through startup, 586 * we verify that the initial encodings were correctly setup. Depending 587 * on Tcl's environment, there may not have been enough information first 588 * time through (above). 589 * 590 * Results: 591 * None. 592 * 593 * Side effects: 594 * The Tcl library path is converted from native encoding to UTF-8, on 595 * the first call, and the encodings may be changed on first or second 596 * call. 597 * 598 *--------------------------------------------------------------------------- 599 */ 600 601void 602TclpSetInitialEncodings(void) 603{ 604 Tcl_DString encodingName; 605 Tcl_SetSystemEncoding(NULL, 606 Tcl_GetEncodingNameFromEnvironment(&encodingName)); 607 Tcl_DStringFree(&encodingName); 608} 609 610void 611TclpSetInterfaces(void) 612{ 613 /* do nothing */ 614} 615 616static CONST char * 617SearchKnownEncodings( 618 CONST char *encoding) 619{ 620 int left = 0; 621 int right = sizeof(localeTable)/sizeof(LocaleTable); 622 623 while (left <= right) { 624 int test = (left + right)/2; 625 int code = strcmp(localeTable[test].lang, encoding); 626 627 if (code == 0) { 628 return localeTable[test].encoding; 629 } 630 if (code < 0) { 631 left = test+1; 632 } else { 633 right = test-1; 634 } 635 } 636 return NULL; 637} 638 639CONST char * 640Tcl_GetEncodingNameFromEnvironment( 641 Tcl_DString *bufPtr) 642{ 643 CONST char *encoding; 644 CONST char *knownEncoding; 645 646 Tcl_DStringInit(bufPtr); 647 648 /* 649 * Determine the current encoding from the LC_* or LANG environment 650 * variables. We previously used setlocale() to determine the locale, but 651 * this does not work on some systems (e.g. Linux/i386 RH 5.0). 652 */ 653 654#ifdef HAVE_LANGINFO 655 if ( 656#ifdef WEAK_IMPORT_NL_LANGINFO 657 nl_langinfo != NULL && 658#endif 659 setlocale(LC_CTYPE, "") != NULL) { 660 Tcl_DString ds; 661 662 /* 663 * Use a DString so we can modify case. 664 */ 665 666 Tcl_DStringInit(&ds); 667 encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); 668 Tcl_UtfToLower(Tcl_DStringValue(&ds)); 669 knownEncoding = SearchKnownEncodings(encoding); 670 if (knownEncoding != NULL) { 671 Tcl_DStringAppend(bufPtr, knownEncoding, -1); 672 } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { 673 Tcl_DStringAppend(bufPtr, encoding, -1); 674 } 675 Tcl_DStringFree(&ds); 676 if (Tcl_DStringLength(bufPtr)) { 677 return Tcl_DStringValue(bufPtr); 678 } 679 } 680#endif /* HAVE_LANGINFO */ 681 682 /* 683 * Classic fallback check. This tries a homebrew algorithm to determine 684 * what encoding should be used based on env vars. 685 */ 686 687 encoding = getenv("LC_ALL"); 688 689 if (encoding == NULL || encoding[0] == '\0') { 690 encoding = getenv("LC_CTYPE"); 691 } 692 if (encoding == NULL || encoding[0] == '\0') { 693 encoding = getenv("LANG"); 694 } 695 if (encoding == NULL || encoding[0] == '\0') { 696 encoding = NULL; 697 } 698 699 if (encoding != NULL) { 700 CONST char *p; 701 Tcl_DString ds; 702 703 Tcl_DStringInit(&ds); 704 p = encoding; 705 encoding = Tcl_DStringAppend(&ds, p, -1); 706 Tcl_UtfToLower(Tcl_DStringValue(&ds)); 707 708 knownEncoding = SearchKnownEncodings(encoding); 709 if (knownEncoding != NULL) { 710 Tcl_DStringAppend(bufPtr, knownEncoding, -1); 711 } else if (NULL != Tcl_GetEncoding(NULL, encoding)) { 712 Tcl_DStringAppend(bufPtr, encoding, -1); 713 } 714 if (Tcl_DStringLength(bufPtr)) { 715 Tcl_DStringFree(&ds); 716 return Tcl_DStringValue(bufPtr); 717 } 718 719 /* 720 * We didn't recognize the full value as an encoding name. If there is 721 * an encoding subfield, we can try to guess from that. 722 */ 723 724 for (p = encoding; *p != '\0'; p++) { 725 if (*p == '.') { 726 p++; 727 break; 728 } 729 } 730 if (*p != '\0') { 731 knownEncoding = SearchKnownEncodings(p); 732 if (knownEncoding != NULL) { 733 Tcl_DStringAppend(bufPtr, knownEncoding, -1); 734 } else if (NULL != Tcl_GetEncoding(NULL, p)) { 735 Tcl_DStringAppend(bufPtr, p, -1); 736 } 737 } 738 Tcl_DStringFree(&ds); 739 if (Tcl_DStringLength(bufPtr)) { 740 return Tcl_DStringValue(bufPtr); 741 } 742 } 743 return Tcl_DStringAppend(bufPtr, TCL_DEFAULT_ENCODING, -1); 744} 745 746/* 747 *--------------------------------------------------------------------------- 748 * 749 * TclpSetVariables -- 750 * 751 * Performs platform-specific interpreter initialization related to the 752 * tcl_library and tcl_platform variables, and other platform-specific 753 * things. 754 * 755 * Results: 756 * None. 757 * 758 * Side effects: 759 * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl 760 * variables. 761 * 762 *---------------------------------------------------------------------- 763 */ 764 765void 766TclpSetVariables( 767 Tcl_Interp *interp) 768{ 769#ifndef NO_UNAME 770 struct utsname name; 771#endif 772 int unameOK; 773 Tcl_DString ds; 774 775#ifdef HAVE_COREFOUNDATION 776 char tclLibPath[MAXPATHLEN + 1]; 777 778#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020 779 /* 780 * Set msgcat fallback locale to current CFLocale identifier. 781 */ 782 783 CFLocaleRef localeRef; 784 785 if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && 786 (localeRef = CFLocaleCopyCurrent())) { 787 CFStringRef locale = CFLocaleGetIdentifier(localeRef); 788 789 if (locale) { 790 char loc[256]; 791 792 if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) { 793 if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { 794 Tcl_ResetResult(interp); 795 } 796 Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); 797 } 798 } 799 CFRelease(localeRef); 800 } 801#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */ 802 803 if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { 804 CONST char *str; 805 CFBundleRef bundleRef; 806 807 Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); 808 Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY); 809 Tcl_SetVar(interp, "tcl_pkgPath", " ", 810 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 811 812 str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); 813 if ((str != NULL) && (str[0] != '\0')) { 814 char *p = Tcl_DStringValue(&ds); 815 816 /* 817 * Convert DYLD_FRAMEWORK_PATH from colon to space separated. 818 */ 819 820 do { 821 if (*p == ':') { 822 *p = ' '; 823 } 824 } while (*p++); 825 Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), 826 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 827 Tcl_SetVar(interp, "tcl_pkgPath", " ", 828 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 829 Tcl_DStringFree(&ds); 830 } 831 bundleRef = CFBundleGetMainBundle(); 832 if (bundleRef) { 833 CFURLRef frameworksURL; 834 Tcl_StatBuf statBuf; 835 836 frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef); 837 if (frameworksURL) { 838 if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, 839 (unsigned char*) tclLibPath, MAXPATHLEN) && 840 ! TclOSstat(tclLibPath, &statBuf) && 841 S_ISDIR(statBuf.st_mode)) { 842 Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, 843 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 844 Tcl_SetVar(interp, "tcl_pkgPath", " ", 845 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 846 } 847 CFRelease(frameworksURL); 848 } 849 frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef); 850 if (frameworksURL) { 851 if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE, 852 (unsigned char*) tclLibPath, MAXPATHLEN) && 853 ! TclOSstat(tclLibPath, &statBuf) && 854 S_ISDIR(statBuf.st_mode)) { 855 Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, 856 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 857 Tcl_SetVar(interp, "tcl_pkgPath", " ", 858 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 859 } 860 CFRelease(frameworksURL); 861 } 862 } 863 Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, 864 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 865 } else 866#endif /* HAVE_COREFOUNDATION */ 867 { 868 Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); 869 } 870 871#ifdef DJGPP 872 Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); 873#else 874 Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); 875#endif 876 877 unameOK = 0; 878#ifndef NO_UNAME 879 if (uname(&name) >= 0) { 880 CONST char *native; 881 882 unameOK = 1; 883 884 native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds); 885 Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY); 886 Tcl_DStringFree(&ds); 887 888 /* 889 * The following code is a special hack to handle differences in the 890 * way version information is returned by uname. On most systems the 891 * full version number is available in name.release. However, under 892 * AIX the major version number is in name.version and the minor 893 * version number is in name.release. 894 */ 895 896 if ((strchr(name.release, '.') != NULL) 897 || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */ 898 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, 899 TCL_GLOBAL_ONLY); 900 } else { 901#ifdef DJGPP 902 /* 903 * For some obscure reason DJGPP puts major version into 904 * name.release and minor into name.version. As of DJGPP 2.04 this 905 * is documented in djgpp libc.info file. 906 */ 907 908 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, 909 TCL_GLOBAL_ONLY); 910 Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", 911 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); 912 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, 913 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); 914#else 915 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, 916 TCL_GLOBAL_ONLY); 917 Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", 918 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); 919 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, 920 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); 921 922#endif /* DJGPP */ 923 } 924 Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, 925 TCL_GLOBAL_ONLY); 926 } 927#endif /* !NO_UNAME */ 928 if (!unameOK) { 929 Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); 930 Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); 931 Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); 932 } 933 934 /* 935 * Copy the username of the real user (according to getuid()) into 936 * tcl_platform(user). 937 */ 938 939 { 940 struct passwd *pwEnt = TclpGetPwUid(getuid()); 941 const char *user; 942 943 if (pwEnt == NULL) { 944 user = ""; 945 Tcl_DStringInit(&ds); /* ensure cleanliness */ 946 } else { 947 user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds); 948 } 949 950 Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); 951 Tcl_DStringFree(&ds); 952 } 953} 954 955/* 956 *---------------------------------------------------------------------- 957 * 958 * TclpFindVariable -- 959 * 960 * Locate the entry in environ for a given name. On Unix this routine is 961 * case sensetive, on Windows this matches mixed case. 962 * 963 * Results: 964 * The return value is the index in environ of an entry with the name 965 * "name", or -1 if there is no such entry. The integer at *lengthPtr is 966 * filled in with the length of name (if a matching entry is found) or 967 * the length of the environ array (if no matching entry is found). 968 * 969 * Side effects: 970 * None. 971 * 972 *---------------------------------------------------------------------- 973 */ 974 975int 976TclpFindVariable( 977 CONST char *name, /* Name of desired environment variable 978 * (native). */ 979 int *lengthPtr) /* Used to return length of name (for 980 * successful searches) or number of non-NULL 981 * entries in environ (for unsuccessful 982 * searches). */ 983{ 984 int i, result = -1; 985 register CONST char *env, *p1, *p2; 986 Tcl_DString envString; 987 988 Tcl_DStringInit(&envString); 989 for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { 990 p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); 991 p2 = name; 992 993 for (; *p2 == *p1; p1++, p2++) { 994 /* NULL loop body. */ 995 } 996 if ((*p1 == '=') && (*p2 == '\0')) { 997 *lengthPtr = p2 - name; 998 result = i; 999 goto done; 1000 } 1001 1002 Tcl_DStringFree(&envString); 1003 } 1004 1005 *lengthPtr = i; 1006 1007 done: 1008 Tcl_DStringFree(&envString); 1009 return result; 1010} 1011 1012#ifndef TCL_NO_STACK_CHECK 1013/* 1014 *---------------------------------------------------------------------- 1015 * 1016 * TclpGetCStackParams -- 1017 * 1018 * Determine the stack params for the current thread: in which 1019 * direction does the stack grow, and what is the stack lower (resp. 1020 * upper) bound for safe invocation of a new command? This is used to 1021 * cache the values needed for an efficient computation of 1022 * TclpCheckStackSpace() when the interp is known. 1023 * 1024 * Results: 1025 * Returns 1 if the stack grows down, in which case a stack lower bound 1026 * is stored at stackBoundPtr. If the stack grows up, 0 is returned and 1027 * an upper bound is stored at stackBoundPtr. If a bound cannot be 1028 * determined NULL is stored at stackBoundPtr. 1029 * 1030 *---------------------------------------------------------------------- 1031 */ 1032 1033int 1034TclpGetCStackParams( 1035 int **stackBoundPtr) 1036{ 1037 int result = TCL_OK; 1038 size_t stackSize = 0; /* The size of the current stack. */ 1039 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 1040 /* Most variables are actually in a 1041 * thread-specific data block to minimise the 1042 * impact on the stack. */ 1043#ifdef TCL_CROSS_COMPILE 1044 if (stackGrowsDown == -1) { 1045 /* 1046 * Not initialised! 1047 */ 1048 1049 stackGrowsDown = StackGrowsDown(&result); 1050 } 1051#endif 1052 1053 /* 1054 * The first time through in a thread: record the "outermost" stack 1055 * frame and inquire with the OS about the stack size. 1056 */ 1057 1058 if (tsdPtr->outerVarPtr == NULL) { 1059 tsdPtr->outerVarPtr = &result; 1060 result = GetStackSize(&stackSize); 1061 if (result != TCL_OK) { 1062 /* Can't check, assume it always succeeds */ 1063#ifdef TCL_CROSS_COMPILE 1064 stackGrowsDown = 1; 1065#endif 1066 tsdPtr->stackBound = NULL; 1067 goto done; 1068 } 1069 } 1070 1071 if (stackSize || (tsdPtr->stackBound && 1072 ((stackGrowsDown && (&result < tsdPtr->stackBound)) || 1073 (!stackGrowsDown && (&result > tsdPtr->stackBound))))) { 1074 /* 1075 * Either the thread's first pass or stack failure: set the params 1076 */ 1077 1078 if (!stackSize) { 1079 /* 1080 * Stack failure: if we didn't already blow up, we are within the 1081 * safety area. Recheck with the OS in case the stack was grown. 1082 */ 1083 result = GetStackSize(&stackSize); 1084 if (result != TCL_OK) { 1085 /* Can't check, assume it always succeeds */ 1086#ifdef TCL_CROSS_COMPILE 1087 stackGrowsDown = 1; 1088#endif 1089 tsdPtr->stackBound = NULL; 1090 goto done; 1091 } 1092 } 1093 1094 if (stackGrowsDown) { 1095 tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr - 1096 stackSize); 1097 } else { 1098 tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr + 1099 stackSize); 1100 } 1101 } 1102 1103 done: 1104 *stackBoundPtr = tsdPtr->stackBound; 1105 return stackGrowsDown; 1106} 1107 1108#ifdef TCL_CROSS_COMPILE 1109int 1110StackGrowsDown( 1111 int *parent) 1112{ 1113 int here; 1114 return (&here < parent); 1115} 1116#endif 1117 1118/* 1119 *---------------------------------------------------------------------- 1120 * 1121 * GetStackSize -- 1122 * 1123 * Discover what the stack size for the current thread/process actually 1124 * is. Expects to only ever be called once per thread and then only at a 1125 * point when there is a reasonable amount of space left on the current 1126 * stack; TclpCheckStackSpace is called sufficiently frequently that that 1127 * is true. 1128 * 1129 * Results: 1130 * TCL_OK if the stack space was discovered, TCL_BREAK if the stack space 1131 * was undiscoverable in a way that stack checks should fail, and 1132 * TCL_CONTINUE if the stack space was undiscoverable in a way that stack 1133 * checks should succeed. 1134 * 1135 * Side effects: 1136 * None 1137 * 1138 *---------------------------------------------------------------------- 1139 */ 1140 1141static int 1142GetStackSize( 1143 size_t *stackSizePtr) 1144{ 1145 size_t rawStackSize; 1146 struct rlimit rLimit; /* The result from getrlimit(). */ 1147 1148#ifdef TCL_THREADS 1149 rawStackSize = TclpThreadGetStackSize(); 1150 if (rawStackSize == (size_t) -1) { 1151 /* 1152 * Some kind of confirmed error in TclpThreadGetStackSize?! Fall back 1153 * to whatever getrlimit can determine. 1154 */ 1155 STACK_DEBUG(("stack checks: TclpThreadGetStackSize failed in \n")); 1156 } 1157 if (rawStackSize > 0) { 1158 goto finalSanityCheck; 1159 } 1160 1161 /* 1162 * If we have zero or an error, try the system limits instead. After all, 1163 * the pthread documentation states that threads should always be bound by 1164 * the system stack size limit in any case. 1165 */ 1166#endif /* TCL_THREADS */ 1167 1168 if (getrlimit(RLIMIT_STACK, &rLimit) != 0) { 1169 /* 1170 * getrlimit() failed, just fail the whole thing. 1171 */ 1172 STACK_DEBUG(("skipping stack checks with failure: getrlimit failed\n")); 1173 return TCL_BREAK; 1174 } 1175 if (rLimit.rlim_cur == RLIM_INFINITY) { 1176 /* 1177 * Limit is "infinite"; there is no stack limit. 1178 */ 1179 STACK_DEBUG(("skipping stack checks with success: infinite limit\n")); 1180 return TCL_CONTINUE; 1181 } 1182 rawStackSize = rLimit.rlim_cur; 1183 1184 /* 1185 * Final sanity check on the determined stack size. If we fail this, 1186 * assume there are bogus values about and that we can't actually figure 1187 * out what the stack size really is. 1188 */ 1189 1190#ifdef TCL_THREADS /* Stop warning... */ 1191 finalSanityCheck: 1192#endif 1193 if (rawStackSize <= 0) { 1194 STACK_DEBUG(("skipping stack checks with success\n")); 1195 return TCL_CONTINUE; 1196 } 1197 1198 /* 1199 * Calculate a stack size with a safety margin. 1200 */ 1201 1202 *stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR) 1203 - (getpagesize() * TCL_RESERVED_STACK_PAGES); 1204 1205 return TCL_OK; 1206} 1207#endif /* TCL_NO_STACK_CHECK */ 1208 1209/* 1210 *---------------------------------------------------------------------- 1211 * 1212 * MacOSXGetLibraryPath -- 1213 * 1214 * If we have a bundle structure for the Tcl installation, then check 1215 * there first to see if we can find the libraries there. 1216 * 1217 * Results: 1218 * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. 1219 * 1220 * Side effects: 1221 * Same as for Tcl_MacOSXOpenVersionedBundleResources. 1222 * 1223 *---------------------------------------------------------------------- 1224 */ 1225 1226#ifdef HAVE_COREFOUNDATION 1227static int 1228MacOSXGetLibraryPath( 1229 Tcl_Interp *interp, 1230 int maxPathLen, 1231 char *tclLibPath) 1232{ 1233 int foundInFramework = TCL_ERROR; 1234 1235#ifdef TCL_FRAMEWORK 1236 foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, 1237 "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, 1238 tclLibPath); 1239#endif 1240 1241 return foundInFramework; 1242} 1243#endif /* HAVE_COREFOUNDATION */ 1244 1245/* 1246 * Local Variables: 1247 * mode: c 1248 * c-basic-offset: 4 1249 * fill-column: 78 1250 * End: 1251 */ 1252