1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
-
+
|
/*
* tclUnixTest.c --
*
* Contains platform specific test commands for the Unix platform.
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclUnixTest.c,v 1.14.4.14 2008/07/29 20:14:18 dgp Exp $
* RCS: @(#) $Id: tclUnixTest.c,v 1.14.4.15 2008/10/11 03:37:32 dgp Exp $
*/
#include "tclInt.h"
/*
* The headers are needed for the testalarm command that verifies the use of
* SA_RESTART in signal handlers.
|
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
-
-
|
static int TestalarmCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestgotsigCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static void AlarmHandler(int signum);
static int TestchmodCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TeststacklimitCmd(ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
(ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "teststacklimit", TeststacklimitCmd,
(ClientData) 0, NULL);
}
/*
*----------------------------------------------------------------------
*
* TeststacklimitCmd --
*
* This function implements the "teststacklimit" command. When called
* with no arguments is sets the interp result to the current stack
* limit. When called with an integer argument it will set the stack size
* to the requested number (or the hard limit if it is smaller) and set
* the interp's result to the stack size prevalent before the change.
* Stack sizes are expressed in kB, as in 'ulimit'.
*
* A size of -1 means "unlimited".
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May change the C stack size limit.
*
*----------------------------------------------------------------------
*/
static int
TeststacklimitCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
#define STACK_SCALE 1024
struct rlimit rlim;
int prev_limit, new_limit, result;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, " ?limit?\"");
return TCL_ERROR;
}
getrlimit(RLIMIT_STACK, &rlim);
prev_limit = ((rlim.rlim_cur == RLIM_INFINITY)
? -1
: (int) (rlim.rlim_cur/STACK_SCALE));
if (objc == 2) {
result = Tcl_GetIntFromObj(interp, objv[1], &new_limit);
if (result != TCL_OK) {
return result;
}
rlim.rlim_cur = ((new_limit == -1)
? RLIM_INFINITY
: STACK_SCALE * (rlim_t) new_limit);
setrlimit(RLIMIT_STACK, &rlim);
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(prev_limit));
return TCL_OK;
#undef STACK_SCALE
|