root/tcl-8.0/tags/rat_4_2_18/unix/tclUnixInit.c @ 1173

Revision 1173, 7.9 KB (checked in by anonymous, 14 years ago)

This commit was manufactured by cvs2svn to create tag 'rat_4_2_18'.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1/*
2 * tclUnixInit.c --
3 *
4 *      Contains the Unix-specific interpreter initialization functions.
5 *
6 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
7 *
8 * See the file "license.terms" for information on usage and redistribution
9 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 *
11 * SCCS: @(#) tclUnixInit.c 1.26 97/08/05 20:09:25
12 */
13
14#include "tclInt.h"
15#include "tclPort.h"
16#if defined(__FreeBSD__)
17#   include <floatingpoint.h>
18#endif
19#if defined(__bsdi__)
20#   include <sys/param.h>
21#   if _BSDI_VERSION > 199501
22#       include <dlfcn.h>
23#   endif
24#endif
25
26extern char lib_history[];
27extern char lib_init[];
28extern char lib_ldAout[];
29extern char lib_http[];
30extern char lib_optparse[];
31extern char lib_parray[];
32extern char lib_safe[];
33extern char lib_word[];
34
35/*
36 * Default directory in which to look for Tcl library scripts.  The
37 * symbol is defined by Makefile.
38 */
39
40static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY;
41
42/*
43 * Directory in which to look for packages (each package is typically
44 * installed as a subdirectory of this directory).  The symbol is
45 * defined by Makefile.
46 */
47
48static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
49
50/*
51 * Is this module initialized?
52 */
53
54static int initialized = 0;
55
56/*
57 * The Init script, tclPreInitScript variable, and the routine
58 * TclSetPreInitScript (common to Windows and Unix platforms) are defined
59 * in generic/tclInitScript.h.
60 */
61
62#include "tclInitScript.h"
63
64/*
65 * Static routines in this file:
66 */
67
68static void     PlatformInitExitHandler _ANSI_ARGS_((ClientData clientData));
69
70/*
71 *----------------------------------------------------------------------
72 *
73 * PlatformInitExitHandler --
74 *
75 *      Uninitializes all values on unload, so that this module can
76 *      be later reinitialized.
77 *
78 * Results:
79 *      None.
80 *
81 * Side effects:
82 *      Returns the module to uninitialized state.
83 *
84 *----------------------------------------------------------------------
85 */
86
87static void
88PlatformInitExitHandler(clientData)
89    ClientData clientData;              /* Unused. */
90{
91    initialized = 0;
92}
93
94/*
95 *----------------------------------------------------------------------
96 *
97 * TclPlatformInit --
98 *
99 *      Performs Unix-specific interpreter initialization related to the
100 *      tcl_library and tcl_platform variables, and other platform-
101 *      specific things.
102 *
103 * Results:
104 *      None.
105 *
106 * Side effects:
107 *      Sets "tcl_library" and "tcl_platform" Tcl variables.
108 *
109 *----------------------------------------------------------------------
110 */
111
112void
113TclPlatformInit(interp)
114    Tcl_Interp *interp;
115{
116#ifndef NO_UNAME
117    struct utsname name;
118#endif
119    int unameOK;
120
121    tclPlatform = TCL_PLATFORM_UNIX;
122    Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir,
123            TCL_GLOBAL_ONLY);
124    Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
125    Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
126    unameOK = 0;
127#ifndef NO_UNAME
128    if (uname(&name) >= 0) {
129        unameOK = 1;
130        Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
131                TCL_GLOBAL_ONLY);
132        /*
133         * The following code is a special hack to handle differences in
134         * the way version information is returned by uname.  On most
135         * systems the full version number is available in name.release.
136         * However, under AIX the major version number is in
137         * name.version and the minor version number is in name.release.
138         */
139
140        if ((strchr(name.release, '.') != NULL)
141                || !isdigit(UCHAR(name.version[0]))) {
142            Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
143                    TCL_GLOBAL_ONLY);
144        } else {
145            Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
146                    TCL_GLOBAL_ONLY);
147            Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
148                    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
149            Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
150                    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
151        }
152        Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
153                TCL_GLOBAL_ONLY);
154    }
155#endif
156    if (!unameOK) {
157        Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
158        Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
159        Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
160    }
161
162    if (!initialized) {
163
164        /*
165         * Create an exit handler so that uninitialization will be done
166         * on unload.
167         */
168       
169        Tcl_CreateExitHandler(PlatformInitExitHandler, NULL);
170       
171        /*
172         * The code below causes SIGPIPE (broken pipe) errors to
173         * be ignored.  This is needed so that Tcl processes don't
174         * die if they create child processes (e.g. using "exec" or
175         * "open") that terminate prematurely.  The signal handler
176         * is only set up when the first interpreter is created;
177         * after this the application can override the handler with
178         * a different one of its own, if it wants.
179         */
180   
181#ifdef SIGPIPE
182        (void) signal(SIGPIPE, SIG_IGN);
183#endif /* SIGPIPE */
184
185#ifdef __FreeBSD__
186        fpsetround(FP_RN);
187        fpsetmask(0L);
188#endif
189
190#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
191        /*
192         * Find local symbols. Don't report an error if we fail.
193         */
194        (void) dlopen (NULL, RTLD_NOW);
195#endif
196        initialized = 1;
197    }
198}
199
200/*
201 *----------------------------------------------------------------------
202 *
203 * Tcl_Init --
204 *
205 *      This procedure is typically invoked by Tcl_AppInit procedures
206 *      to perform additional initialization for a Tcl interpreter,
207 *      such as sourcing the "init.tcl" script.
208 *
209 * Results:
210 *      Returns a standard Tcl completion code and sets interp->result
211 *      if there is an error.
212 *
213 * Side effects:
214 *      Depends on what's in the init.tcl script.
215 *
216 *----------------------------------------------------------------------
217 */
218
219int
220Tcl_Init(interp)
221    Tcl_Interp *interp;         /* Interpreter to initialize. */
222{
223    if (tclPreInitScript != NULL) {
224        if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
225            return (TCL_ERROR);
226        };
227    }
228    if (Tcl_Eval(interp, lib_init) != TCL_OK) {
229        return TCL_ERROR;
230    }
231    if (Tcl_Eval(interp, lib_optparse) != TCL_OK) {
232        return TCL_ERROR;
233    }
234    if (Tcl_Eval(interp, lib_safe) != TCL_OK) {
235        return TCL_ERROR;
236    }
237    if (Tcl_Eval(interp, lib_history) != TCL_OK) {
238        return TCL_ERROR;
239    }
240    if (Tcl_Eval(interp, lib_ldAout) != TCL_OK) {
241        return TCL_ERROR;
242    }
243    if (Tcl_Eval(interp, lib_parray) != TCL_OK) {
244        return TCL_ERROR;
245    }
246    if (Tcl_Eval(interp, lib_word) != TCL_OK) {
247        return TCL_ERROR;
248    }
249    if (Tcl_Eval(interp, lib_http) != TCL_OK) {
250        return TCL_ERROR;
251    }
252    return(Tcl_Eval(interp, initScript));
253}
254
255/*
256 *----------------------------------------------------------------------
257 *
258 * Tcl_SourceRCFile --
259 *
260 *      This procedure is typically invoked by Tcl_Main of Tk_Main
261 *      procedure to source an application specific rc file into the
262 *      interpreter at startup time.
263 *
264 * Results:
265 *      None.
266 *
267 * Side effects:
268 *      Depends on what's in the rc script.
269 *
270 *----------------------------------------------------------------------
271 */
272
273void
274Tcl_SourceRCFile(interp)
275    Tcl_Interp *interp;         /* Interpreter to source rc file into. */
276{
277    Tcl_DString temp;
278    char *fileName;
279    Tcl_Channel errChannel;
280
281    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
282
283    if (fileName != NULL) {
284        Tcl_Channel c;
285        char *fullName;
286
287        Tcl_DStringInit(&temp);
288        fullName = Tcl_TranslateFileName(interp, fileName, &temp);
289        if (fullName == NULL) {
290            /*
291             * Couldn't translate the file name (e.g. it referred to a
292             * bogus user or there was no HOME environment variable).
293             * Just do nothing.
294             */
295        } else {
296
297            /*
298             * Test for the existence of the rc file before trying to read it.
299             */
300
301            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
302            if (c != (Tcl_Channel) NULL) {
303                Tcl_Close(NULL, c);
304                if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
305                    errChannel = Tcl_GetStdChannel(TCL_STDERR);
306                    if (errChannel) {
307                        Tcl_Write(errChannel, interp->result, -1);
308                        Tcl_Write(errChannel, "\n", 1);
309                    }
310                }
311            }
312        }
313        Tcl_DStringFree(&temp);
314    }
315}
Note: See TracBrowser for help on using the browser.