tclunixinit.c

tcl是工具命令语言

/* 
 * tclUnixInit.c --
 *
 *	Contains the Unix-specific interpreter initialization functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 * All rights reserved.
 *
 * RCS: @(#) $Id: tclUnixInit.c,v 1.34 2002/10/22 16:41:28 das Exp $
 */

#if defined(HAVE_CFBUNDLE)
#include <CoreFoundation/CoreFoundation.h>
#endif
#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
#ifdef HAVE_LANGINFO
#include <langinfo.h>
#endif
#if defined(__FreeBSD__)
#   include <floatingpoint.h>
#endif
#if defined(__bsdi__)
#   include <sys/param.h>
#   if _BSDI_VERSION > 199501
#	include <dlfcn.h>
#   endif
#endif

/*
 * The Init script (common to Windows and Unix platforms) is
 * defined in tkInitScript.h
 */
#include "tclInitScript.h"

/* Used to store the encoding used for binary files */
static Tcl_Encoding binaryEncoding = NULL;
/* Has the basic library path encoding issue been fixed */
static int libraryPathEncodingFixed = 0;

/*
 * Tcl tries to use standard and homebrew methods to guess the right
 * encoding on the platform.  However, there is always a final fallback,
 * and this value is it.  Make sure it is a real Tcl encoding.
 */

#ifndef TCL_DEFAULT_ENCODING
#define TCL_DEFAULT_ENCODING "iso8859-1"
#endif

/*
 * Default directory in which to look for Tcl library scripts.  The
 * symbol is defined by Makefile.
 */

static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY;

/*
 * Directory in which to look for packages (each package is typically
 * installed as a subdirectory of this directory).  The symbol is
 * defined by Makefile.
 */

static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;

/*
 * The following table is used to map from Unix locale strings to
 * encoding files.  If HAVE_LANGINFO is defined, then this is a fallback
 * table when the result from nl_langinfo isn't a recognized encoding.
 * Otherwise this is the first list checked for a mapping from env
 * encoding to Tcl encoding name.
 */

typedef struct LocaleTable {
    CONST char *lang;
    CONST char *encoding;
} LocaleTable;

static CONST LocaleTable localeTable[] = {
#ifdef HAVE_LANGINFO
    {"gb2312-1980",	"gb2312"},
#ifdef __hpux
    {"SJIS",		"shiftjis"},
    {"eucjp",		"euc-jp"},
    {"euckr",		"euc-kr"},
    {"euctw",		"euc-cn"},
    {"greek8",		"cp869"},
    {"iso88591",	"iso8859-1"},
    {"iso88592",	"iso8859-2"},
    {"iso88595",	"iso8859-5"},
    {"iso88596",	"iso8859-6"},
    {"iso88597",	"iso8859-7"},
    {"iso88598",	"iso8859-8"},
    {"iso88599",	"iso8859-9"},
    {"iso885915",	"iso8859-15"},
    {"roman8",		"iso8859-1"},
    {"tis620",		"tis-620"},
    {"turkish8",	"cp857"},
    {"utf8",		"utf-8"},
#endif /* __hpux */
#endif /* HAVE_LANGINFO */

    {"ja_JP.SJIS",	"shiftjis"},
    {"ja_JP.EUC",	"euc-jp"},
    {"ja_JP.eucJP",     "euc-jp"},
    {"ja_JP.JIS",	"iso2022-jp"},
    {"ja_JP.mscode",	"shiftjis"},
    {"ja_JP.ujis",	"euc-jp"},
    {"ja_JP",		"euc-jp"},
    {"Ja_JP",		"shiftjis"},
    {"Jp_JP",		"shiftjis"},
    {"japan",		"euc-jp"},
#ifdef hpux
    {"japanese",	"shiftjis"},	
    {"ja",		"shiftjis"},	
#else
    {"japanese",	"euc-jp"},
    {"ja",		"euc-jp"},
#endif
    {"japanese.sjis",	"shiftjis"},
    {"japanese.euc",	"euc-jp"},
    {"japanese-sjis",	"shiftjis"},
    {"japanese-ujis",	"euc-jp"},

    {"ko",              "euc-kr"},
    {"ko_KR",           "euc-kr"},
    {"ko_KR.EUC",       "euc-kr"},
    {"ko_KR.euc",       "euc-kr"},
    {"ko_KR.eucKR",     "euc-kr"},
    {"korean",          "euc-kr"},

    {"ru",		"iso8859-5"},		
    {"ru_RU",		"iso8859-5"},		
    {"ru_SU",		"iso8859-5"},		

    {"zh",		"cp936"},

    {NULL, NULL}
};

#ifdef HAVE_CFBUNDLE
static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath);
#endif /* HAVE_CFBUNDLE */


/*
 *---------------------------------------------------------------------------
 *
 * TclpInitPlatform --
 *
 *	Initialize all the platform-dependant things like signals and
 *	floating-point error handling.
 *
 *	Called at process initialization time.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TclpInitPlatform()
{
    tclPlatform = TCL_PLATFORM_UNIX;

    /*
     * The code below causes SIGPIPE (broken pipe) errors to
     * be ignored.  This is needed so that Tcl processes don't
     * die if they create child processes (e.g. using "exec" or
     * "open") that terminate prematurely.  The signal handler
     * is only set up when the first interpreter is created;
     * after this the application can override the handler with
     * a different one of its own, if it wants.
     */

#ifdef SIGPIPE
    (void) signal(SIGPIPE, SIG_IGN);
#endif /* SIGPIPE */

#ifdef __FreeBSD__
    fpsetround(FP_RN);
    fpsetmask(0L);
#endif

#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
    /*
     * Find local symbols. Don't report an error if we fail.
     */
    (void) dlopen (NULL, RTLD_NOW);			/* INTL: Native. */
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpInitLibraryPath --
 *
 *	Initialize the library path at startup.  We have a minor
 *	metacircular problem that we don't know the encoding of the
 *	operating system but we may need to talk to operating system
 *	to find the library directories so that we know how to talk to
 *	the operating system.
 *
 *	We do not know the encoding of the operating system.
 *	We do know that the encoding is some multibyte encoding.
 *	In that multibyte encoding, the characters 0..127 are equivalent
 *	    to ascii.
 *
 *	So although we don't know the encoding, it's safe:
 *	    to look for the last slash character in a path in the encoding.
 *	    to append an ascii string to a path.
 *	    to pass those strings back to the operating system.
 *
 *	But any strings that we remembered before we knew the encoding of
 *	the operating system must be translated to UTF-8 once we know the
 *	encoding so that the rest of Tcl can use those strings.
 *
 *	This call sets the library path to strings in the unknown native
 *	encoding.  TclpSetInitialEncodings() will translate the library
 *	path from the native encoding to UTF-8 as soon as it determines
 *	what the native encoding actually is.
 *
 *	Called at process initialization time.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(path)
CONST char *path;		/* Path to the executable in native 
				 * multi-byte encoding. */
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    CONST char *str;
    Tcl_DString buffer, ds;
    int pathc;
    CONST char **pathv;
    char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];

    Tcl_DStringInit(&ds);
    pathPtr = Tcl_NewObj();

    /*
     * Initialize the substrings used when locating an executable.  The
     * installLib variable computes the path as though the executable
     * is installed.  The developLib computes the path as though the
     * executable is run from a develpment directory.
     */
     
    sprintf(installLib, "lib/tcl%s", TCL_VERSION);
    sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);

    /*
     * Look for the library relative to default encoding dir.
     */

    str = Tcl_GetDefaultEncodingDir();
    if ((str != NULL) && (str[0] != '\0')) {
	objPtr = Tcl_NewStringObj(str, -1);
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
    }

    /*
     * Look for the library relative to the TCL_LIBRARY env variable.
     * If the last dirname in the TCL_LIBRARY path does not match the
     * last dirname in the installLib variable, use the last dir name
     * of installLib in addition to the orginal TCL_LIBRARY path.
     */

    str = getenv("TCL_LIBRARY");			/* INTL: Native. */
    Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
    str = Tcl_DStringValue(&buffer);

    if ((str != NULL) && (str[0] != '\0')) {
	/*
	 * If TCL_LIBRARY is set, search there.
	 */
	 
	objPtr = Tcl_NewStringObj(str, -1);
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current
	     * version string.
	     */
	    
	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	ckfree((char *) pathv);
    }

    /*
     * Look for the library relative to the executable.  This algorithm
     * should be the same as the one in the tcl_findLibrary procedure.
     *
     * This code looks in the following directories:
     *
     *	<bindir>/../<installLib>
     *	  (e.g. /usr/local/bin/../lib/tcl8.4)
     *	<bindir>/../../<installLib>
     *	  (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
     *	<bindir>/../library
     *	  (e.g. /usr/src/tcl8.4.0/unix/../library)
     *	<bindir>/../../library
     *	  (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
     *	<bindir>/../../<developLib>
     *	  (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
     *	<bindir>/../../../<developLib>
     *	  (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
     */
     

     /*
      * The variable path holds an absolute path.  Take care not to
      * overwrite pathv[0] since that might produce a relative path.
      */

    if (path != NULL) {
	Tcl_SplitPath(path, &pathc, &pathv);
	if (pathc > 2) {
	    str = pathv[pathc - 2];
	    pathv[pathc - 2] = installLib;
	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
	    pathv[pathc - 2] = str;
	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	if (pathc > 3) {
	    str = pathv[pathc - 3];
	    pathv[pathc - 3] = installLib;
	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
	    pathv[pathc - 3] = str;
	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	if (pathc > 2) {
	    str = pathv[pathc - 2];
	    pathv[pathc - 2] = "library";
	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
	    pathv[pathc - 2] = str;
	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	if (pathc > 3) {
	    str = pathv[pathc - 3];
	    pathv[pathc - 3] = "library";
	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
	    pathv[pathc - 3] = str;
	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	if (pathc > 3) {
	    str = pathv[pathc - 3];
	    pathv[pathc - 3] = developLib;
	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
	    pathv[pathc - 3] = str;
	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	if (pathc > 4) {
	    str = pathv[pathc - 4];
	    pathv[pathc - 4] = developLib;
	    path = Tcl_JoinPath(pathc - 3, pathv, &ds);
	    pathv[pathc - 4] = str;
	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	ckfree((char *) pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path.
     * This is needed when users install Tcl with an exec-prefix that
     * is different from the prtefix.
     */
			      
    {
#ifdef HAVE_CFBUNDLE
    char tclLibPath[MAXPATHLEN + 1];
    
    if (Tcl_MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
        str = tclLibPath;
    } else
#endif /* HAVE_CFBUNDLE */
    {
        str = defaultLibraryDir;
    }
    if (str[0] != '\0') {
        objPtr = Tcl_NewStringObj(str, -1);
        Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
    }
    }

    TclSetLibraryPath(pathPtr);    
    Tcl_DStringFree(&buffer);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --
 *
 *	Based on the locale, determine the encoding of the operating
 *	system and the default encoding for newly opened files.
 *
 *	Called at process initialization time, and part way through
 *	startup, we verify that the initial encodings were correctly
 *	setup.  Depending on Tcl's environment, there may not have been
 *	enough information first time through (above).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tcl library path is converted from native encoding to UTF-8,
 *	on the first call, and the encodings may be changed on first or
 *	second call.
 *
 *---------------------------------------------------------------------------
 */

void
TclpSetInitialEncodings()
{
    if (libraryPathEncodingFixed == 0) {
	CONST char *encoding = NULL;
	int i, setSysEncCode = TCL_ERROR;
	Tcl_Obj *pathPtr;

	/*
	 * Determine the current encoding from the LC_* or LANG environment
	 * variables.  We previously used setlocale() to determine the locale,
	 * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
	 */
#ifdef HAVE_LANGINFO
	if (setlocale(LC_CTYPE, "") != NULL) {
	    Tcl_DString ds;

	    /*
	     * Use a DString so we can overwrite it in name compatability
	     * checks below.
	     */

	    Tcl_DStringInit(&ds);
	    encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);

	    Tcl_UtfToLower(Tcl_DStringValue(&ds));
#ifdef HAVE_LANGINFO_DEBUG
	    fprintf(stderr, "encoding '%s'", encoding);
#endif
	    if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o'
		    && encoding[3] == '-') {
		char *p, *q;
		/* need to strip '-' from iso-* encoding */
		for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4;
		    *p; *p++ = *q++);
	    } else if (encoding[0] == 'i' && encoding[1] == 'b'
		    && encoding[2] == 'm' && encoding[3] >= '0'
		    && encoding[3] <= '9') {
		char *p, *q;
		/* if langinfo reports "ibm*" we should use "cp*" */
		p = Tcl_DStringValue(&ds);
		*p++ = 'c'; *p++ = 'p';
		for(q = p+1; *p ; *p++ = *q++);
	    } else if ((*encoding == '\0')
		    || !strcmp(encoding, "ansi_x3.4-1968")) {
		/* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */
		encoding = "iso8859-1";
	    }
#ifdef HAVE_LANGINFO_DEBUG
	    fprintf(stderr, " ?%s?", encoding);
#endif
	    setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
	    if (setSysEncCode != TCL_OK) {
		/*
		 * If this doesn't return TCL_OK, the encoding returned by
		 * nl_langinfo or as we translated it wasn't accepted.  Do
		 * this fallback check.  If this fails, we will enter the
		 * old fallback below.
		 */

		for (i = 0; localeTable[i].lang != NULL; i++) {
		    if (strcmp(localeTable[i].lang, encoding) == 0) {
			setSysEncCode = Tcl_SetSystemEncoding(NULL,
				localeTable[i].encoding);
			break;
		    }
		}
	    }
#ifdef HAVE_LANGINFO_DEBUG
	    fprintf(stderr, " => '%s'\n", encoding);
#endif
	    Tcl_DStringFree(&ds);
	}
#ifdef HAVE_LANGINFO_DEBUG