1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #include <caml/mlvalues.h>
17 #include <caml/alloc.h>
18 #include <caml/fail.h>
19 #include <caml/memory.h>
20 #include "unixsupport.h"
21
22 #ifdef HAS_SETITIMER
23
24 #include <math.h>
25 #include <sys/time.h>
26
unix_set_timeval(struct timeval * tv,double d)27 static void unix_set_timeval(struct timeval * tv, double d)
28 {
29 double integr, frac;
30 frac = modf(d, &integr);
31 /* Round time up so that if d is small but not 0, we end up with
32 a non-0 timeval. */
33 tv->tv_sec = integr;
34 tv->tv_usec = ceil(1e6 * frac);
35 if (tv->tv_usec >= 1000000) { tv->tv_sec++; tv->tv_usec = 0; }
36 }
37
unix_convert_itimer(struct itimerval * tp)38 static value unix_convert_itimer(struct itimerval *tp)
39 {
40 #define Get_timeval(tv) (double) tv.tv_sec + (double) tv.tv_usec / 1e6
41 value res = caml_alloc_small(Double_wosize * 2, Double_array_tag);
42 Store_double_field(res, 0, Get_timeval(tp->it_interval));
43 Store_double_field(res, 1, Get_timeval(tp->it_value));
44 return res;
45 #undef Get_timeval
46 }
47
48 static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF };
49
unix_setitimer(value which,value newval)50 CAMLprim value unix_setitimer(value which, value newval)
51 {
52 struct itimerval new, old;
53 unix_set_timeval(&new.it_interval, Double_field(newval, 0));
54 unix_set_timeval(&new.it_value, Double_field(newval, 1));
55 if (setitimer(itimers[Int_val(which)], &new, &old) == -1)
56 uerror("setitimer", Nothing);
57 return unix_convert_itimer(&old);
58 }
59
unix_getitimer(value which)60 CAMLprim value unix_getitimer(value which)
61 {
62 struct itimerval val;
63 if (getitimer(itimers[Int_val(which)], &val) == -1)
64 uerror("getitimer", Nothing);
65 return unix_convert_itimer(&val);
66 }
67
68 #else
69
unix_setitimer(value which,value newval)70 CAMLprim value unix_setitimer(value which, value newval)
71 { caml_invalid_argument("setitimer not implemented"); }
unix_getitimer(value which)72 CAMLprim value unix_getitimer(value which)
73 { caml_invalid_argument("getitimer not implemented"); }
74
75 #endif
76