l4/pkg/ocaml/ocaml/contrib/otherlibs/unix/itimer.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: itimer.c 6824 2005-03-24 17:20:54Z doligez $ */
  15
  16 #include <mlvalues.h>
  17 #include <alloc.h>
  18 #include <fail.h>
  19 #include <memory.h>
  20 #include "unixsupport.h"
  21
  22 #ifdef HAS_SETITIMER
  23
  24 #include <math.h>
  25 #include <sys/time.h>
  26
  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
  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 = 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
  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
  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
  70 CAMLprim value unix_setitimer(value which, value newval)
  71 { invalid_argument("setitimer not implemented"); }
  72 CAMLprim value unix_getitimer(value which)
  73 { invalid_argument("getitimer not implemented"); }
  74
  75 #endif