summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixInit.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixInit.c')
-rw-r--r--unix/tclUnixInit.c317
1 files changed, 317 insertions, 0 deletions
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
new file mode 100644
index 0000000..91d866f
--- /dev/null
+++ b/unix/tclUnixInit.c
@@ -0,0 +1,317 @@
+/*
+ * 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
+
+/*
+ * Default directory in which to look for Tcl library scripts. The
+ * symbol is defined by Makefile.
+ */
+
+static char defaultLibraryDir[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[200] = TCL_PACKAGE_PATH;
+
+/*
+ * Is this module initialized?
+ */
+
+static int initialized = 0;
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It looks on disk in several different directories
+ * for a script "init.tcl" that is compatible with this version
+ * of Tcl. The init.tcl script does all of the real work of
+ * initialization.
+ */
+
+static char initScript[] =
+"proc tclInit {} {\n\
+ global tcl_library tcl_version tcl_patchLevel env errorInfo\n\
+ global tcl_pkgPath\n\
+ rename tclInit {}\n\
+ set errors {}\n\
+ set dirs {}\n\
+ if [info exists env(TCL_LIBRARY)] {\n\
+ lappend dirs $env(TCL_LIBRARY)\n\
+ }\n\
+ lappend dirs [info library]\n\
+ set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
+ lappend dirs $parentDir/lib/tcl$tcl_version\n\
+ if [string match {*[ab]*} $tcl_patchLevel] {\n\
+ set lib tcl$tcl_patchLevel\n\
+ } else {\n\
+ set lib tcl$tcl_version\n\
+ }\n\
+ lappend dirs [file dirname $parentDir]/$lib/library\n\
+ lappend dirs $parentDir/library\n\
+ foreach i $dirs {\n\
+ set tcl_library $i\n\
+ set tclfile [file join $i init.tcl]\n\
+ if {[file exists $tclfile]} {\n\
+ lappend tcl_pkgPath [file dirname $i]\n\
+ if ![catch {uplevel #0 [list source $tclfile]} msg] {\n\
+ return\n\
+ } else {\n\
+ append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
+ }\n\
+ }\n\
+ }\n\
+ set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
+ append msg \" $dirs\n\n\"\n\
+ append msg \"$errors\n\n\"\n\
+ append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
+ error $msg\n\
+}\n\
+tclInit";
+
+/*
+ * 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. */
+{
+ strcpy(defaultLibraryDir, TCL_LIBRARY);
+ strcpy(pkgPath, TCL_PACKAGE_PATH);
+ 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, "tcl_library", 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(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. */
+{
+ 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);
+ }
+}