1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
/*
* 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.10 96/03/12 09:05:59
*/
#include "tclInt.h"
#include "tclPort.h"
#ifndef NO_UNAME
# include <sys/utsname.h>
#endif
#if defined(__FreeBSD__)
#include <floatingpoint.h>
#endif
/*
* Default directory in which to look for libraries:
*/
static char defaultLibraryDir[200] = TCL_LIBRARY;
/*
* 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 init {} {\n\
global tcl_library tcl_version tcl_patchLevel env\n\
rename init {}\n\
set dirs {}\n\
if [info exists env(TCL_LIBRARY)] {\n\
lappend dirs $env(TCL_LIBRARY)\n\
}\n\
lappend dirs [info library]\n\
lappend dirs [file dirname [file dirname [info nameofexecutable]]]/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 [file dirname [pwd]]]/$lib/library\n\
lappend dirs [file dirname [pwd]]/library\n\
foreach i $dirs {\n\
set tcl_library $i\n\
if ![catch {uplevel #0 source $i/init.tcl}] {\n\
return\n\
}\n\
}\n\
set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
append msg \" $dirs\n\"\n\
append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
error $msg\n\
}\n\
init";
/*
*----------------------------------------------------------------------
*
* 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;
static int initialized = 0;
tclPlatform = TCL_PLATFORM_UNIX;
Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, 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);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY);
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) {
/*
* 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
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);
}
|
