root/tcl-8.0/trunk/unix/tclUnixInit.c @ 1091

/* 
 * tclUnixInit.c --
 *
 *      Contains the Unix-specific interpreter initialization functions.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclUnixInit.c 1.26 97/08/05 20:09:25
 */

#include "tclInt.h"
#include "tclPort.h"
#if defined(__FreeBSD__)
#   include <floatingpoint.h>
#endif
#if defined(__bsdi__)
#   include <sys/param.h>
#   if _BSDI_VERSION > 199501
#       include <dlfcn.h>
#   endif
#endif

extern char lib_history[];
extern char lib_init[];
extern char lib_ldAout[];
extern char lib_http[];
extern char lib_optparse[];
extern char lib_parray[];
extern char lib_safe[];
extern char lib_word[];

/*
 * 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;

/*
 * Is this module initialized?
 */

static int initialized = 0;

/*
 * The Init script, tclPreInitScript variable, and the routine
 * TclSetPreInitScript (common to Windows and Unix platforms) are defined
 * in generic/tclInitScript.h.
 */

#include "tclInitScript.h"

/*
 * Static routines in this file:
 */

static void     PlatformInitExitHandler _ANSI_ARGS_((ClientData clientData));

/*
 *----------------------------------------------------------------------
 *
 * PlatformInitExitHandler --
 *
 *      Uninitializes all values on unload, so that this module can
 *      be later reinitialized.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Returns the module to uninitialized state.
 *
 *----------------------------------------------------------------------
 */

static void
PlatformInitExitHandler(clientData)
    ClientData clientData;              /* Unused. */
{
    initialized = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPlatformInit --
 *
 *      Performs Unix-specific interpreter initialization related to the
 *      tcl_library and tcl_platform variables, and other platform-
 *      specific things.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Sets "tcl_library" and "tcl_platform" Tcl variables.
 *
 *----------------------------------------------------------------------
 */

void
TclPlatformInit(interp)
    Tcl_Interp *interp;
{
#ifndef NO_UNAME
    struct utsname name;
#endif
    int unameOK;

    tclPlatform = TCL_PLATFORM_UNIX;
    Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir,
            TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
    unameOK = 0;
#ifndef NO_UNAME
    if (uname(&name) >= 0) {
        unameOK = 1;
        Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
                TCL_GLOBAL_ONLY);
        /*
         * The following code is a special hack to handle differences in
         * the way version information is returned by uname.  On most
         * systems the full version number is available in name.release.
         * However, under AIX the major version number is in
         * name.version and the minor version number is in name.release.
         */

        if ((strchr(name.release, '.') != NULL)
                || !isdigit(UCHAR(name.version[0]))) {
            Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
                    TCL_GLOBAL_ONLY);
        } else {
            Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
                    TCL_GLOBAL_ONLY);
            Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
                    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
            Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
                    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
        }
        Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
                TCL_GLOBAL_ONLY);
    }
#endif
    if (!unameOK) {
        Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
        Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
        Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
    }

    if (!initialized) {

        /*
         * Create an exit handler so that uninitialization will be done
         * on unload.
         */
        
        Tcl_CreateExitHandler(PlatformInitExitHandler, NULL);
        
        /*
         * 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);
#endif
        initialized = 1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Init --
 *
 *      This procedure is typically invoked by Tcl_AppInit procedures
 *      to perform additional initialization for a Tcl interpreter,
 *      such as sourcing the "init.tcl" script.
 *
 * Results:
 *      Returns a standard Tcl completion code and sets interp->result
 *      if there is an error.
 *
 * Side effects:
 *      Depends on what's in the init.tcl script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Init(interp)
    Tcl_Interp *interp;         /* Interpreter to initialize. */
{
    if (tclPreInitScript != NULL) {
        if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
            return (TCL_ERROR);
        };
    }
    if (Tcl_Eval(interp, lib_init) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_optparse) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_safe) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_history) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_ldAout) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_parray) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_word) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_Eval(interp, lib_http) != TCL_OK) {
        return TCL_ERROR;
    }
    return(Tcl_Eval(interp, initScript));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SourceRCFile --
 *
 *      This procedure is typically invoked by Tcl_Main of Tk_Main
 *      procedure to source an application specific rc file into the
 *      interpreter at startup time.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Depends on what's in the rc script.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SourceRCFile(interp)
    Tcl_Interp *interp;         /* Interpreter to source rc file into. */
{
    Tcl_DString temp;
    char *fileName;
    Tcl_Channel errChannel;

    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);

    if (fileName != NULL) {
        Tcl_Channel c;
        char *fullName;

        Tcl_DStringInit(&temp);
        fullName = Tcl_TranslateFileName(interp, fileName, &temp);
        if (fullName == NULL) {
            /*
             * Couldn't translate the file name (e.g. it referred to a
             * bogus user or there was no HOME environment variable).
             * Just do nothing.
             */
        } else {

            /*
             * Test for the existence of the rc file before trying to read it.
             */

            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
            if (c != (Tcl_Channel) NULL) {
                Tcl_Close(NULL, c);
                if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
                    errChannel = Tcl_GetStdChannel(TCL_STDERR);
                    if (errChannel) {
                        Tcl_Write(errChannel, interp->result, -1);
                        Tcl_Write(errChannel, "\n", 1);
                    }
                }
            }
        }
        Tcl_DStringFree(&temp);
    }
}