v0.94
[apc.git] / ml_apc.c
blobfb402e3fabc95f4cbd9f806825923c316858537c
1 #define _XOPEN_SOURCE 700
2 #define _GNU_SOURCE
3 #include <caml/fail.h>
4 #include <caml/alloc.h>
5 #include <caml/memory.h>
6 #include <caml/custom.h>
7 #include <caml/signals.h>
8 #include <caml/mlvalues.h>
9 #include <caml/bigarray.h>
11 #include <alloca.h>
12 #include <unistd.h>
13 #include <stdarg.h>
14 #include <stdio.h>
15 #include <sys/time.h>
16 #include <sys/time.h>
17 #include <sys/sysinfo.h>
18 #include <signal.h>
19 #include <string.h>
20 #include <errno.h>
22 static void failwith_fmt (const char *fmt, ...) Noreturn;
23 static void failwith_fmt (const char *fmt, ...)
25 va_list ap;
26 char buf[1024];
28 va_start (ap, fmt);
29 vsnprintf (buf, sizeof (buf), fmt, ap);
30 va_end (ap);
32 failwith (buf);
35 CAMLprim value ml_waitalrm (value unit_v)
37 CAMLparam1 (unit_v);
38 sigset_t set;
39 int signr;
41 sigemptyset (&set);
42 sigaddset (&set, SIGALRM);
44 caml_enter_blocking_section ();
46 if (sigwait (&set, &signr)) {
47 failwith_fmt ("sigwait: %s", strerror (errno));
50 caml_leave_blocking_section ();
52 CAMLreturn (Val_unit);
55 CAMLprim value ml_sysinfo (value unit_v)
57 CAMLparam1 (unit_v);
58 CAMLlocal2 (res_v, loads_v);
59 struct sysinfo si;
61 if (sysinfo (&si)) {
62 failwith_fmt ("sysinfo: %s", strerror (errno));
65 loads_v = caml_alloc_tuple (3);
66 Store_field (loads_v, 0, caml_copy_int64 (si.loads[0]));
67 Store_field (loads_v, 1, caml_copy_int64 (si.loads[1]));
68 Store_field (loads_v, 2, caml_copy_int64 (si.loads[2]));
70 res_v = caml_alloc_tuple (9);
71 Store_field (res_v, 0, caml_copy_int64 (si.uptime));
72 Store_field (res_v, 1, loads_v);
73 Store_field (res_v, 2, caml_copy_int64 (si.totalram));
74 Store_field (res_v, 3, caml_copy_int64 (si.freeram));
75 Store_field (res_v, 4, caml_copy_int64 (si.sharedram));
76 Store_field (res_v, 5, caml_copy_int64 (si.bufferram));
77 Store_field (res_v, 6, caml_copy_int64 (si.totalswap));
78 Store_field (res_v, 7, caml_copy_int64 (si.freeswap));
79 Store_field (res_v, 8, caml_copy_int64 (si.procs));
81 CAMLreturn (res_v);
84 CAMLprim value ml_get_nprocs (value unit_v)
86 CAMLparam1 (unit_v);
87 int nprocs;
89 nprocs = get_nprocs ();
90 if (nprocs <= 0) {
91 failwith_fmt ("get_nprocs: %s", strerror (errno));
94 CAMLreturn (Val_int (nprocs));
97 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
99 CAMLparam2 (fd_v, nprocs_v);
100 CAMLlocal1 (res_v);
101 struct timeval tv;
102 int fd = Int_val (fd_v);
103 int nprocs = Int_val (nprocs_v);
104 size_t n = nprocs * sizeof (tv);
105 ssize_t m;
106 struct timeval *buf;
107 int i;
109 buf = alloca (n);
110 if (!buf) {
111 failwith_fmt ("alloca: %s", strerror (errno));
114 m = read (fd, buf, n);
115 if (n - m) {
116 failwith_fmt ("read [n=%zu, m=%zi]: %s", n, m, strerror (errno));
119 res_v = caml_alloc (nprocs * Double_wosize, Double_array_tag);
120 for (i = 0; i < nprocs; ++i) {
121 double d = buf[i].tv_sec + buf[i].tv_usec * 1e-6;
123 Store_double_field (res_v, i, d);
125 CAMLreturn (res_v);
128 CAMLprim value ml_get_hz (value unit_v)
130 CAMLparam1 (unit_v);
131 CAMLreturn (Val_int (sysconf (_SC_CLK_TCK)));
134 CAMLprim value ml_nice (value nice_v)
136 CAMLparam1 (nice_v);
137 int niceval = Int_val (nice_v);
139 if (!nice (niceval)) {
140 failwith_fmt ("nice %d: %s", niceval, strerror (errno));
143 CAMLreturn (Val_unit);
146 #include <X11/X.h>
147 #include <X11/Xmd.h>
148 #include <X11/Xlib.h>
149 #include <X11/Xatom.h>
151 #include <GL/glx.h>
153 struct X11State {
154 Display *dpy;
155 Window id;
156 Atom property;
157 int error;
160 CAMLprim value ml_seticon (value data_v)
162 CAMLparam1 (data_v);
163 static struct X11State static_state;
164 struct X11State *s = &static_state;
165 void *ptr = String_val (data_v);
166 CARD32 *p = ptr;
167 unsigned char *data = ptr;
169 if (!s->error) {
170 if (!s->dpy) {
171 s->dpy = XOpenDisplay (NULL);
172 if (!s->dpy) {
173 goto err0;
175 else {
176 /* "tiny bit" hackish */
177 s->id = glXGetCurrentDrawable ();
178 if (s->id == None) {
179 goto err1;
182 s->property = XInternAtom (s->dpy, "_NET_WM_ICON", False);
183 if (s->property == None){
184 goto err1;
187 #ifdef DEBUG
188 printf ("id = %#x, property = %d\n",
189 (int) s->id, (int) s->property);
190 #endif
195 p[0] = 32;
196 p[1] = 32;
197 XChangeProperty (s->dpy, s->id, s->property, XA_CARDINAL,
198 32, PropModeReplace, data, 32 * 32 + 2);
200 CAMLreturn (Val_unit);
202 err1:
203 XCloseDisplay (s->dpy);
204 err0:
205 s->error = 1;
206 CAMLreturn (Val_unit);