ml_apc.c

   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>
  10
  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>
  21
  22 static void failwith_fmt (const char *fmt, ...) Noreturn;
  23 static void failwith_fmt (const char *fmt, ...)
  24 {
  25     va_list ap;
  26     char buf[1024];
  27
  28     va_start (ap, fmt);
  29     vsnprintf (buf, sizeof (buf), fmt, ap);
  30     va_end (ap);
  31
  32     failwith (buf);
  33 }
  34
  35
  36 CAMLprim value ml_waitalrm (value unit_v)
  37 {
  38     CAMLparam1 (unit_v);
  39     sigset_t set;
  40     int signr;
  41
  42     sigemptyset (&set);
  43     sigaddset (&set, SIGALRM);
  44
  45     caml_enter_blocking_section ();
  46     {
  47         if (sigwait (&set, &signr)) {
  48             failwith_fmt ("sigwait: %s", strerror (errno));
  49         }
  50     }
  51     caml_leave_blocking_section ();
  52
  53     CAMLreturn (Val_unit);
  54 }
  55
  56 CAMLprim value ml_sysinfo (value unit_v)
  57 {
  58     CAMLparam1 (unit_v);
  59     CAMLlocal2 (res_v, loads_v);
  60     struct sysinfo si;
  61
  62     if (sysinfo (&si)) {
  63         failwith_fmt ("sysinfo: %s", strerror (errno));
  64     }
  65
  66     loads_v = caml_alloc_tuple (3);
  67     Store_field (loads_v, 0, caml_copy_int64 (si.loads[0]));
  68     Store_field (loads_v, 1, caml_copy_int64 (si.loads[1]));
  69     Store_field (loads_v, 2, caml_copy_int64 (si.loads[2]));
  70
  71     res_v = caml_alloc_tuple (9);
  72     Store_field (res_v, 0, caml_copy_int64 (si.uptime));
  73     Store_field (res_v, 1, loads_v);
  74     Store_field (res_v, 2, caml_copy_int64 (si.totalram));
  75     Store_field (res_v, 3, caml_copy_int64 (si.freeram));
  76     Store_field (res_v, 4, caml_copy_int64 (si.sharedram));
  77     Store_field (res_v, 5, caml_copy_int64 (si.bufferram));
  78     Store_field (res_v, 6, caml_copy_int64 (si.totalswap));
  79     Store_field (res_v, 7, caml_copy_int64 (si.freeswap));
  80     Store_field (res_v, 8, caml_copy_int64 (si.procs));
  81
  82     CAMLreturn (res_v);
  83 }
  84
  85 CAMLprim value ml_get_nprocs (value unit_v)
  86 {
  87     CAMLparam1 (unit_v);
  88     int nprocs;
  89
  90     nprocs = get_nprocs ();
  91     if (nprocs <= 0) {
  92         failwith_fmt ("get_nprocs: %s", strerror (errno));
  93     }
  94
  95     CAMLreturn (Val_int (nprocs));
  96 }
  97
  98 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
  99 {
 100     CAMLparam2 (fd_v, nprocs_v);
 101     CAMLlocal1 (res_v);
 102     struct timeval tv;
 103     int fd = Int_val (fd_v);
 104     int nprocs = Int_val (nprocs_v);
 105     size_t n = nprocs * sizeof (tv);
 106     ssize_t m;
 107     struct timeval *buf;
 108     int i;
 109
 110     buf = alloca (n);
 111     if (!buf) {
 112         failwith_fmt ("alloca: %s", strerror (errno));
 113     }
 114
 115     m = read (fd, buf, n);
 116     if (n - m) {
 117         failwith_fmt ("read [n=%zu, m=%zi]: %s", n, m, strerror (errno));
 118     }
 119
 120     res_v = caml_alloc (nprocs * Double_wosize, Double_array_tag);
 121     for (i = 0; i < nprocs; ++i) {
 122         double d = buf[i].tv_sec + buf[i].tv_usec * 1e-6;
 123
 124         Store_double_field (res_v, i, d);
 125     }
 126     CAMLreturn (res_v);
 127 }
 128
 129 CAMLprim value ml_get_hz (value unit_v)
 130 {
 131     CAMLparam1 (unit_v);
 132     CAMLreturn (Val_int (sysconf (_SC_CLK_TCK)));
 133 }
 134
 135 CAMLprim value ml_nice (value nice_v)
 136 {
 137     CAMLparam1 (nice_v);
 138     int niceval = Int_val (nice_v);
 139
 140     if (!nice (niceval)) {
 141         failwith_fmt ("nice %d: %s", niceval, strerror (errno));
 142     }
 143
 144     CAMLreturn (Val_unit);
 145 }