1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2014 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Library */
22 /* File: seed7/src/pcslib.c */
23 /* Changes: 2014 Thomas Mertes */
24 /* Content: All primitive actions for the process type. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35
36 #include "common.h"
37 #include "data.h"
38 #include "data_rtl.h"
39 #include "os_decls.h"
40 #include "heaputl.h"
41 #include "syvarutl.h"
42 #include "striutl.h"
43 #include "arrutl.h"
44 #include "objutl.h"
45 #include "runerr.h"
46 #include "pcs_rtl.h"
47 #include "pcs_drv.h"
48
49 #undef EXTERN
50 #define EXTERN
51 #include "pcslib.h"
52
53
54
55 /**
56 * Returns the error output file (stderr) of the given child process.
57 * If the standard error file of the subprocess has been redirected
58 * then this function will return NULL.
59 * @return the error output file of ''process'' or
60 * CLIB_NULL_FILE, if stderr has been redirected.
61 */
pcs_child_stderr(listType arguments)62 objectType pcs_child_stderr (listType arguments)
63
64 { /* pcs_child_stderr */
65 isit_process(arg_1(arguments));
66 return bld_file_temp(
67 pcsChildStdErr(take_process(arg_1(arguments))));
68 } /* pcs_child_stderr */
69
70
71
72 /**
73 * Returns the standard input file (stdin) of the given child process.
74 * If the standard input file of the subprocess has been redirected
75 * then this function will return NULL.
76 * @return the standard input file of ''process'' or
77 * CLIB_NULL_FILE, if stdin has been redirected.
78 */
pcs_child_stdin(listType arguments)79 objectType pcs_child_stdin (listType arguments)
80
81 { /* pcs_child_stdin */
82 isit_process(arg_1(arguments));
83 return bld_file_temp(
84 pcsChildStdIn(take_process(arg_1(arguments))));
85 } /* pcs_child_stdin */
86
87
88
89 /**
90 * Returns the standard output file (stdout) of the given child process.
91 * If the standard output file of the subprocess has been redirected
92 * then this function will return NULL.
93 * @return the standard output file of ''process'' or
94 * CLIB_NULL_FILE, if stdout has been redirected.
95 */
pcs_child_stdout(listType arguments)96 objectType pcs_child_stdout (listType arguments)
97
98 { /* pcs_child_stdout */
99 isit_process(arg_1(arguments));
100 return bld_file_temp(
101 pcsChildStdOut(take_process(arg_1(arguments))));
102 } /* pcs_child_stdout */
103
104
105
106 /**
107 * Compare two processes.
108 * @return -1, 0 or 1 if the first argument is considered to be
109 * respectively less than, equal to, or greater than the
110 * second.
111 */
pcs_cmp(listType arguments)112 objectType pcs_cmp (listType arguments)
113
114 { /* pcs_cmp */
115 isit_process(arg_1(arguments));
116 isit_process(arg_2(arguments));
117 return bld_int_temp(
118 pcsCmp(take_process(arg_1(arguments)), take_process(arg_2(arguments))));
119 } /* pcs_cmp */
120
121
122
123 /**
124 * Assign source/arg_3 to dest/arg_1.
125 * A copy function assumes that dest/arg_1 contains a legal value.
126 */
pcs_cpy(listType arguments)127 objectType pcs_cpy (listType arguments)
128
129 {
130 objectType dest;
131 objectType source;
132 processType process_source;
133 processType old_process;
134
135 /* pcs_cpy */
136 dest = arg_1(arguments);
137 source = arg_3(arguments);
138 isit_process(dest);
139 isit_process(source);
140 is_variable(dest);
141 process_source = take_process(source);
142 if (TEMP_OBJECT(source)) {
143 source->value.processValue = NULL;
144 } else {
145 if (process_source != NULL) {
146 process_source->usage_count++;
147 } /* if */
148 } /* if */
149 old_process = take_process(dest);
150 if (old_process != NULL) {
151 old_process->usage_count--;
152 if (old_process->usage_count == 0) {
153 pcsFree(old_process);
154 } /* if */
155 } /* if */
156 dest->value.processValue = process_source;
157 return SYS_EMPTY_OBJECT;
158 } /* pcs_cpy */
159
160
161
162 /**
163 * Initialize dest/arg_1 and assign source/arg_3 to it.
164 * A create function assumes that the contents of dest/arg_1
165 * is undefined. Create functions can be used to initialize
166 * constants.
167 */
pcs_create(listType arguments)168 objectType pcs_create (listType arguments)
169
170 {
171 objectType source;
172 processType process_value;
173
174 /* pcs_create */
175 source = arg_3(arguments);
176 isit_process(source);
177 SET_CATEGORY_OF_OBJ(arg_1(arguments), PROCESSOBJECT);
178 process_value = take_process(source);
179 arg_1(arguments)->value.processValue = process_value;
180 if (TEMP_OBJECT(source)) {
181 source->value.processValue = NULL;
182 } else {
183 if (process_value != NULL) {
184 process_value->usage_count++;
185 } /* if */
186 } /* if */
187 return SYS_EMPTY_OBJECT;
188 } /* pcs_create */
189
190
191
192 /**
193 * Free the memory referred by 'old_process/arg_1'.
194 * After pcs_destr is left 'old_process/arg_1' is NULL.
195 * The memory where 'old_process/arg_1' is stored can be freed afterwards.
196 */
pcs_destr(listType arguments)197 objectType pcs_destr (listType arguments)
198
199 {
200 processType old_process;
201
202 /* pcs_destr */
203 isit_process(arg_1(arguments));
204 old_process = take_process(arg_1(arguments));
205 if (old_process != NULL) {
206 old_process->usage_count--;
207 if (old_process->usage_count == 0) {
208 pcsFree(old_process);
209 } /* if */
210 arg_1(arguments)->value.processValue = NULL;
211 } /* if */
212 SET_UNUSED_FLAG(arg_1(arguments));
213 return SYS_EMPTY_OBJECT;
214 } /* pcs_destr */
215
216
217
pcs_empty(listType arguments)218 objectType pcs_empty (listType arguments)
219
220 { /* pcs_empty */
221 return bld_process_temp(NULL);
222 } /* pcs_empty */
223
224
225
226 /**
227 * Check if two processes are equal.
228 * @return TRUE if both processes are equal,
229 * FALSE otherwise.
230 */
pcs_eq(listType arguments)231 objectType pcs_eq (listType arguments)
232
233 { /* pcs_eq */
234 isit_process(arg_1(arguments));
235 isit_process(arg_3(arguments));
236 if (pcsEq(take_process(arg_1(arguments)),
237 take_process(arg_3(arguments)))) {
238 return SYS_TRUE_OBJECT;
239 } else {
240 return SYS_FALSE_OBJECT;
241 } /* if */
242 } /* pcs_eq */
243
244
245
246 /**
247 * Return the exit value of the specified process.
248 * By convention, the value 0 indicates normal termination.
249 * @return the exit value of the specified process.
250 */
pcs_exit_value(listType arguments)251 objectType pcs_exit_value (listType arguments)
252
253 { /* pcs_exit_value */
254 isit_process(arg_1(arguments));
255 return bld_int_temp(
256 pcsExitValue(take_process(arg_1(arguments))));
257 } /* pcs_exit_value */
258
259
260
261 /**
262 * Compute the hash value of a process.
263 * @return the hash value.
264 */
pcs_hashcode(listType arguments)265 objectType pcs_hashcode (listType arguments)
266
267 { /* pcs_hashcode */
268 isit_process(arg_1(arguments));
269 return bld_int_temp(
270 pcsHashCode(take_process(arg_1(arguments))));
271 } /* pcs_hashcode */
272
273
274
275 /**
276 * Test whether the specified process is alive.
277 * @return TRUE if the specified process has not yet terminated,
278 * FALSE otherwise.
279 */
pcs_is_alive(listType arguments)280 objectType pcs_is_alive (listType arguments)
281
282 { /* pcs_is_alive */
283 isit_process(arg_1(arguments));
284 if (pcsIsAlive(take_process(arg_1(arguments)))) {
285 return SYS_TRUE_OBJECT;
286 } else {
287 return SYS_FALSE_OBJECT;
288 } /* if */
289 } /* pcs_is_alive */
290
291
292
293 /**
294 * Kill the specified process.
295 * @exception FILE_ERROR It was not possible to kill the process.
296 */
pcs_kill(listType arguments)297 objectType pcs_kill (listType arguments)
298
299 { /* pcs_kill */
300 isit_process(arg_1(arguments));
301 pcsKill(take_process(arg_1(arguments)));
302 return SYS_EMPTY_OBJECT;
303 } /* pcs_kill */
304
305
306
307 /**
308 * Check if two processes are not equal.
309 * @return TRUE if both processes are not equal,
310 * FALSE otherwise.
311 */
pcs_ne(listType arguments)312 objectType pcs_ne (listType arguments)
313
314 { /* pcs_ne */
315 isit_process(arg_1(arguments));
316 isit_process(arg_3(arguments));
317 if (pcsEq(take_process(arg_1(arguments)),
318 take_process(arg_3(arguments)))) {
319 return SYS_FALSE_OBJECT;
320 } else {
321 return SYS_TRUE_OBJECT;
322 } /* if */
323 } /* pcs_ne */
324
325
326
pcs_pipe2(listType arguments)327 objectType pcs_pipe2 (listType arguments)
328
329 {
330 objectType childStdin_variable;
331 objectType childStdout_variable;
332 rtlArrayType parameters;
333
334 /* pcs_pipe2 */
335 isit_stri(arg_1(arguments));
336 isit_array(arg_2(arguments));
337 childStdin_variable = arg_3(arguments);
338 isit_file(childStdin_variable);
339 childStdout_variable = arg_4(arguments);
340 isit_file(childStdout_variable);
341 parameters = gen_rtl_array(take_array(arg_2(arguments)));
342 if (parameters == NULL) {
343 return raise_exception(SYS_MEM_EXCEPTION);
344 } else {
345 pcsPipe2(take_stri(arg_1(arguments)), parameters,
346 &childStdin_variable->value.fileValue,
347 &childStdout_variable->value.fileValue);
348 FREE_RTL_ARRAY(parameters, ARRAY_LENGTH(parameters));
349 } /* if */
350 return SYS_EMPTY_OBJECT;
351 } /* pcs_pipe2 */
352
353
354
pcs_pty(listType arguments)355 objectType pcs_pty (listType arguments)
356
357 {
358 objectType childStdin_variable;
359 objectType childStdout_variable;
360 rtlArrayType parameters;
361
362 /* pcs_pty */
363 isit_stri(arg_1(arguments));
364 isit_array(arg_2(arguments));
365 childStdin_variable = arg_3(arguments);
366 isit_file(childStdin_variable);
367 childStdout_variable = arg_4(arguments);
368 isit_file(childStdout_variable);
369 parameters = gen_rtl_array(take_array(arg_2(arguments)));
370 if (parameters == NULL) {
371 return raise_exception(SYS_MEM_EXCEPTION);
372 } else {
373 pcsPty(take_stri(arg_1(arguments)), parameters,
374 &childStdin_variable->value.fileValue,
375 &childStdout_variable->value.fileValue);
376 FREE_RTL_ARRAY(parameters, ARRAY_LENGTH(parameters));
377 } /* if */
378 return SYS_EMPTY_OBJECT;
379 } /* pcs_pty */
380
381
382
pcs_start(listType arguments)383 objectType pcs_start (listType arguments)
384
385 {
386 rtlArrayType parameters;
387 processType process;
388
389 /* pcs_start */
390 isit_stri(arg_1(arguments));
391 isit_array(arg_2(arguments));
392 isit_file(arg_3(arguments));
393 isit_file(arg_4(arguments));
394 isit_file(arg_5(arguments));
395 logFunction(printf("pcs_start(\"%s\", arr, %d, %d, %d)\n",
396 striAsUnquotedCStri(take_stri(arg_1(arguments))),
397 safe_fileno(take_file(arg_3(arguments))->cFile),
398 safe_fileno(take_file(arg_4(arguments))->cFile),
399 safe_fileno(take_file(arg_5(arguments))->cFile)););
400 parameters = gen_rtl_array(take_array(arg_2(arguments)));
401 if (parameters == NULL) {
402 return raise_exception(SYS_MEM_EXCEPTION);
403 } else {
404 process = pcsStart(take_stri(arg_1(arguments)), parameters,
405 take_file(arg_3(arguments)),
406 take_file(arg_4(arguments)),
407 take_file(arg_5(arguments)));
408 FREE_RTL_ARRAY(parameters, ARRAY_LENGTH(parameters));
409 } /* if */
410 logFunction(printf("pcs_start --> " FMT_U_MEM "\n",
411 (memSizeType) process););
412 return bld_process_temp(process);
413 } /* pcs_start */
414
415
416
417 /**
418 * Convert a 'process' to a string.
419 * The process is converted to a string with the process identifier (PID).
420 * @return the string result of the conversion.
421 * @exception MEMORY_ERROR Not enough memory to represent the result.
422 */
pcs_str(listType arguments)423 objectType pcs_str (listType arguments)
424
425 { /* pcs_str */
426 isit_process(arg_1(arguments));
427 return bld_stri_temp(
428 pcsStr(take_process(arg_1(arguments))));
429 } /* pcs_str */
430
431
432
433 /**
434 * Get 'process' value of the object referenced by 'aReference/arg_1'.
435 * @return the 'process' value of the referenced object.
436 * @exception RANGE_ERROR If 'aReference/arg_1' is NIL or
437 * category(aReference) <> PROCESSOBJECT holds.
438 */
pcs_value(listType arguments)439 objectType pcs_value (listType arguments)
440
441 {
442 objectType aReference;
443 processType process_value;
444
445 /* pcs_value */
446 isit_reference(arg_1(arguments));
447 aReference = take_reference(arg_1(arguments));
448 if (unlikely(aReference == NULL ||
449 CATEGORY_OF_OBJ(aReference) != PROCESSOBJECT)) {
450 logError(printf("pcs_value(");
451 trace1(aReference);
452 printf("): Category is not PROCESSOBJECT.\n"););
453 return raise_exception(SYS_RNG_EXCEPTION);
454 } else {
455 process_value = take_process(aReference);
456 if (process_value != NULL) {
457 process_value->usage_count++;
458 } /* if */
459 return bld_process_temp(process_value);
460 } /* if */
461 } /* pcs_value */
462
463
464
465 /**
466 * Wait until the specified child process has terminated.
467 * Suspend the execution of the calling process until the
468 * specified child has terminated.
469 */
pcs_wait_for(listType arguments)470 objectType pcs_wait_for (listType arguments)
471
472 { /* pcs_wait_for */
473 isit_process(arg_1(arguments));
474 pcsWaitFor(take_process(arg_1(arguments)));
475 return SYS_EMPTY_OBJECT;
476 } /* pcs_wait_for */
477