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
|
#include <sys/types.h>
#include <unistd.h>
#include <wait.h>
#include "escheme.h"
static Scheme_Object *sch_primitivefork(int argc, Scheme_Object **argv)
{
pid_t pid = fork();
return scheme_make_integer(pid);
}
static Scheme_Object *sch_getpid(int argc, Scheme_Object **argv)
{
return scheme_make_integer(getpid());
}
static Scheme_Object *sch_waitpid(int argc, Scheme_Object **argv)
{
if (SCHEME_INTP(argv[0])) {
int pid = SCHEME_INT_VAL(argv[0]);
int status= 0;
waitpid( pid, &status, 0 );
return scheme_make_integer(WEXITSTATUS(status));
} else
scheme_wrong_type("waitpid", "integer", 0, argc, argv);
}
Scheme_Object *scheme_initialize(Scheme_Env *env) {
Scheme_Object *v;
MZ_GC_DECL_REG(1);
MZ_GC_VAR_IN_REG(0, env);
MZ_GC_REG();
v = scheme_make_prim_w_arity(sch_primitivefork, "primitive-fork", 0, 0),
scheme_add_global("primitive-fork", v, env);
v = scheme_make_prim_w_arity(sch_getpid, "getpid", 0, 0),
scheme_add_global("getpid", v, env);
v = scheme_make_prim_w_arity(sch_waitpid, "waitpid", 1, 1),
scheme_add_global("waitpid", v, env);
MZ_GC_UNREG();
return scheme_void;
}
Scheme_Object *scheme_reload(Scheme_Env *env) {
return scheme_initialize(env); /* Nothing special for reload */
}
Scheme_Object *scheme_module_name() {
return scheme_false;
}
|
