]>
git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxproc.c
72183e5d1552faad8edaa55467315d9588fbd5ee
4 * Tcl command to create and manage processes.
5 *-----------------------------------------------------------------------------
6 * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
8 * Permission to use, copy, modify, and distribute this software and its
9 * documentation for any purpose and without fee is hereby granted, provided
10 * that the above copyright notice appear in all copies. Karl Lehenbauer and
11 * Mark Diekhans make no representations about the suitability of this
12 * software for any purpose. It is provided "as is" without express or
14 *-----------------------------------------------------------------------------
15 * $Id: tclXprocess.c,v 2.2 1992/10/30 03:53:30 markd Exp $
16 *-----------------------------------------------------------------------------
22 * These are needed for wait command even if waitpid is not available.
33 *-----------------------------------------------------------------------------
36 * Implements the TCL execl command:
37 * execl prog [argList]
40 * Standard TCL results, may return the UNIX system error message.
42 *-----------------------------------------------------------------------------
45 Tcl_ExeclCmd (clientData
, interp
, argc
, argv
)
46 ClientData clientData
;
51 #define STATIC_ARG_SIZE 12
52 char *staticArgv
[STATIC_ARG_SIZE
];
53 char **argInList
= NULL
;
54 char **argList
= staticArgv
;
57 if ((argc
< 2) || (argc
> 3)) {
58 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
59 " prog [argList]", (char *) NULL
);
64 * If arg list is supplied, split it and build up the arguments to pass.
65 * otherwise, just supply argv[0]. Must be NULL terminated.
68 if (Tcl_SplitList (interp
, argv
[2], &argInCnt
, &argInList
) != TCL_OK
)
71 if (argInCnt
> STATIC_ARG_SIZE
- 2)
72 argList
= (char **) ckalloc ((argInCnt
+ 1) * sizeof (char **));
74 for (idx
= 0; idx
< argInCnt
; idx
++)
75 argList
[idx
+ 1] = argInList
[idx
];
77 argList
[argInCnt
+ 1] = NULL
;
82 argList
[0] = argv
[1]; /* Program name */
84 if (execvp (argv
[1], argList
) < 0) {
85 if (argInList
!= NULL
)
87 if (argList
!= staticArgv
)
90 interp
->result
= Tcl_UnixError (interp
);
97 *-----------------------------------------------------------------------------
100 * Implements the TCL fork command:
104 * Standard TCL results, may return the UNIX system error message.
106 *-----------------------------------------------------------------------------
109 Tcl_ForkCmd (clientData
, interp
, argc
, argv
)
110 ClientData clientData
;
118 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], (char *) NULL
);
124 interp
->result
= Tcl_UnixError (interp
);
128 sprintf(interp
->result
, "%d", pid
);
131 #ifndef TCL_HAVE_WAITPID
134 *-----------------------------------------------------------------------------
137 * Implements the TCL wait command:
140 * This version is for Tcl 6.4 that does not have the waitpid changes (which
141 * have not yet been released).
144 * Standard TCL results, may return the UNIX system error message.
146 *-----------------------------------------------------------------------------
149 Tcl_WaitCmd (clientData
, interp
, argc
, argv
)
150 ClientData clientData
;
155 WAIT_STATUS_TYPE status
;
156 int pid
, returnedPid
;
160 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " pid",
165 if (Tcl_GetInt (interp
, argv
[1], &pid
) != TCL_OK
)
168 returnedPid
= Tcl_WaitPids (1, &pid
, (WAIT_STATUS_TYPE
*) &status
);
170 if (returnedPid
< 0) {
171 interp
->result
= Tcl_UnixError (interp
);
175 if (WIFEXITED (status
))
176 sprintf (interp
->result
, "%d %s %d", returnedPid
, "EXIT",
177 WEXITSTATUS (status
));
178 else if (WIFSIGNALED (status
))
179 sprintf (interp
->result
, "%d %s %s", returnedPid
, "SIG",
180 Tcl_SignalId (WTERMSIG (status
)));
181 else if (WIFSTOPPED (status
))
182 sprintf (interp
->result
, "%d %s %s", returnedPid
, "STOP",
183 Tcl_SignalId (WSTOPSIG (status
)));
191 *-----------------------------------------------------------------------------
194 * Implements the TCL wait command:
195 * wait [-nohang] [-untraced] [-pgroup] [pid]
198 * Standard TCL results, may return the UNIX system error message.
200 *-----------------------------------------------------------------------------
203 Tcl_WaitCmd (clientData
, interp
, argc
, argv
)
204 ClientData clientData
;
209 int pid
, returnedPid
, status
, idx
;
210 int options
= 0, pgroup
= FALSE
;
212 for (idx
= 1; idx
< argc
; idx
++) {
213 if (argv
[idx
][0] != '-')
215 if (STREQU ("-nohang", argv
[idx
])) {
216 if (options
& WNOHANG
)
221 if (STREQU ("-untraced", argv
[idx
])) {
222 if (options
& WUNTRACED
)
224 options
|= WUNTRACED
;
227 if (STREQU ("-pgroup", argv
[idx
])) {
233 goto usage
; /* None match */
236 * Check for more than one non-minus argument. If ok, convert pid,
242 if (Tcl_GetInt (interp
, argv
[idx
], &pid
) != TCL_OK
)
245 Tcl_AppendResult (interp
, "pid or process group must be greater ",
246 "than zero", (char *) NULL
);
250 pid
= -1; /* pid not supplied */
253 #if !TCL_HAVE_WAITPID
255 * Versions that don't have real waitpid have limited functionality.
257 if ((options
!= 0) || pgroup
) {
258 Tcl_AppendResult (interp
, "The \"-nohang\", \"-untraced\" and ",
259 "\"-pgroup\" options are not available on this ",
260 "system", (char *) NULL
);
272 returnedPid
= waitpid (pid
, &status
, options
);
274 if (returnedPid
< 0) {
275 interp
->result
= Tcl_UnixError (interp
);
279 if (WIFEXITED (status
))
280 sprintf (interp
->result
, "%d %s %d", returnedPid
, "EXIT",
281 WEXITSTATUS (status
));
282 else if (WIFSIGNALED (status
))
283 sprintf (interp
->result
, "%d %s %s", returnedPid
, "SIG",
284 Tcl_SignalId (WTERMSIG (status
)));
285 else if (WIFSTOPPED (status
))
286 sprintf (interp
->result
, "%d %s %s", returnedPid
, "STOP",
287 Tcl_SignalId (WSTOPSIG (status
)));
292 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " ",
293 "[-nohang] [-untraced] [-pgroup] [pid]",