Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/unix/tclUnixInit.c @ 25

Last change on this file since 25 was 25, checked in by landauf, 16 years ago

added tcl to libs
File size: 33.7 KB
Line 
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
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(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
347MODULE_SCOPE long tclMacOSXDarwinRelease;
348long 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
371void
372TclpInitPlatform(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
475void
476TclpInitLibraryPath(
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
600void
601TclpSetInitialEncodings(void)
602{
603    Tcl_DString encodingName;
604    Tcl_SetSystemEncoding(NULL,
605            Tcl_GetEncodingNameFromEnvironment(&encodingName));
606    Tcl_DStringFree(&encodingName);
607}
608
609void
610TclpSetInterfaces(void)
611{
612    /* do nothing */
613}
614
615static CONST char *
616SearchKnownEncodings(
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
638CONST char *
639Tcl_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
764void
765TclpSetVariables(
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
974int
975TclpFindVariable(
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
1032int
1033TclpGetCStackParams(
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
1108int
1109StackGrowsDown(
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
1140static int
1141GetStackSize(
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
1226static int
1227MacOSXGetLibraryPath(
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 */
Note: See TracBrowser for help on using the repository browser.