forked from xapi-project/xen-api
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
77ab1d5
commit 599ad2d
Showing
83 changed files
with
362 additions
and
115 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -18,6 +18,7 @@ | |
sha | ||
stunnel | ||
threads.posix | ||
timers | ||
uuid | ||
xapi-backtrace | ||
xapi-consts.xapi_version | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,9 @@ | ||
(library | ||
(name timers) | ||
(public_name xapi-timers) | ||
(libraries threads.posix) | ||
(foreign_stubs | ||
(language c) | ||
(names nice_stubs timer_stubs) | ||
) | ||
) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,4 @@ | ||
(** [nice delta] changes the nice value of the current thread on Linux by [delta], and return the new value. | ||
[nice 0] can be used to query the current value without altering it. | ||
*) | ||
external nice: int -> int = "ml_nice" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,15 @@ | ||
#include <caml/mlvalues.h> | ||
#include <caml/memory.h> | ||
#include <caml/unixsupport.h> | ||
#include <errno.h> | ||
|
||
CAMLprim value ml_nice(value delta) | ||
{ | ||
CAMLparam1(delta); | ||
/* see manpage, a successful nice can legitimately return -1. */ | ||
errno = 0; | ||
int rc = nice(Int_val(delta)); | ||
if (-1 == rc && errno) | ||
uerror("nice", Nothing); | ||
CAMLreturn(Val_int(rc)); | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,23 @@ | ||
type t | ||
|
||
external cpu_timer_create : bool -> t = "ml_cpu_timer_create" | ||
|
||
external cpu_timer_destroy : t -> unit = "ml_cpu_timer_destroy" | ||
|
||
external cpu_timer_settime : t -> float -> unit = "ml_cpu_timer_settime" | ||
|
||
external cpu_timer_gettime : t -> float = "ml_cpu_timer_gettime" | ||
|
||
let with_cpu_timer ~is_thread ~interval f = | ||
let t = cpu_timer_create is_thread in | ||
let finally () = cpu_timer_destroy t in | ||
Fun.protect ~finally @@ fun () -> | ||
cpu_timer_settime t interval ; | ||
f t | ||
|
||
let default_interval = Atomic.make 0.005 | ||
|
||
let thread_create f arg = | ||
Thread.create | ||
(with_cpu_timer ~is_thread:true ~interval:(Atomic.get default_interval)) | ||
(fun (_ : t) -> f arg) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,29 @@ | ||
type t | ||
|
||
(** [with_cpu_timer ~is_thread ~interval f] creates a POSIX timer with [timer_create], | ||
and sets it to deliver [SIGVTALRM] whenever the process or thread has consumed [interval] seconds of CPU time. | ||
The signal will be redelivered periodically every time the process or thread consumes [interval] more seconds of CPU time. | ||
The timer is disarmed and destroyed when [f] finishes. | ||
This can be used to limit the amount of time a single thread can hold the OCaml master lock. | ||
@param is_thread whether to measure time per thread or per process | ||
@param interval in seconds when to deliver [SIGVTALRM] | ||
@param f the function to call with this timer armed | ||
*) | ||
val with_cpu_timer: is_thread:bool -> interval:float -> (t -> 'a) -> 'a | ||
|
||
(** [cpu_timer_settime t interval] changes the [SIGVTALRM] delivery interval to [interval]. | ||
A [0.] value disarms the timer. | ||
*) | ||
val cpu_timer_settime: t -> float -> unit | ||
|
||
(** [cpu_timer_gettime t] retrieves the current value of the timer [t] in seconds. *) | ||
val cpu_timer_gettime: t -> float | ||
|
||
val default_interval: float Atomic.t | ||
|
||
val thread_create: ('a -> 'b) -> 'a -> Thread.t | ||
(** [thread_create f arg] is a wrapper for [Thread.create f arg] that sets up an interval timer with {!val:with_cpu_timer}, | ||
with a default interval. | ||
*) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,134 @@ | ||
#include <bits/time.h> | ||
#define CAML_NAME_SPACE | ||
#include <caml/alloc.h> | ||
#include <caml/custom.h> | ||
#include <caml/memory.h> | ||
#include <caml/mlvalues.h> | ||
#include <caml/threads.h> | ||
#include <caml/unixsupport.h> | ||
|
||
#include <errno.h> | ||
#include <signal.h> | ||
#include <string.h> | ||
#include <time.h> | ||
|
||
#define timer_t_val(v) (*((timer_t **)Data_custom_val(v))) | ||
|
||
static int ml_cpu_timer_free(value timer) { | ||
/* Called from finalizer, must not raise exceptions, and must not use | ||
the CAML* macros | ||
*/ | ||
timer_t *timerid_ptr = timer_t_val(timer); | ||
if (timerid_ptr) { | ||
timer_t timerid = *timerid_ptr; | ||
/* prevent double-free */ | ||
timer_t_val(timer) = NULL; | ||
caml_stat_free(timerid_ptr); | ||
|
||
return timer_delete(timerid); | ||
} | ||
/* timer has already been freed, matches what timer_delete would return on bad | ||
* timer_t */ | ||
errno = EINVAL; | ||
return -1; | ||
} | ||
|
||
void ml_cpu_timer_finalise(value timer) { ml_cpu_timer_free(timer); } | ||
|
||
static struct custom_operations timer_ops = {"timer_t", | ||
ml_cpu_timer_finalise, | ||
custom_compare_default, | ||
custom_hash_default, | ||
custom_serialize_default, | ||
custom_deserialize_default, | ||
custom_compare_ext_default, | ||
custom_fixed_length_default}; | ||
|
||
CAMLprim value ml_cpu_timer_create(value is_thread) { | ||
CAMLparam1(is_thread); | ||
CAMLlocal1(timer); | ||
clockid_t clock = | ||
Bool_val(is_thread) ? CLOCK_THREAD_CPUTIME_ID : CLOCK_PROCESS_CPUTIME_ID; | ||
struct sigevent sev; | ||
timer_t *timerid; | ||
|
||
timer = caml_alloc_custom(&timer_ops, sizeof(timer_t *), 0, 1); | ||
/* initialize, in case the allocation below fails */ | ||
timer_t_val(timer) = NULL; | ||
|
||
timerid = caml_stat_alloc(sizeof(timer_t)); | ||
|
||
memset(&sev, 0, sizeof(sev)); | ||
sev.sigev_notify = SIGEV_SIGNAL; | ||
sev.sigev_signo = SIGVTALRM; /* same as SIGPREEMPTION in OCaml runtime */ | ||
sev.sigev_value.sival_ptr = timerid; | ||
|
||
caml_enter_blocking_section(); | ||
int rc = timer_create(clock, &sev, timerid); | ||
caml_leave_blocking_section(); | ||
|
||
if (-1 == rc) { | ||
caml_stat_free(timerid); | ||
uerror("timer_create", Nothing); | ||
} | ||
/* only store value once we know it contains a valid timer */ | ||
timer_t_val(timer) = timerid; | ||
|
||
CAMLreturn(timer); | ||
} | ||
|
||
CAMLprim value ml_cpu_timer_destroy(value timer) { | ||
CAMLparam1(timer); | ||
caml_enter_blocking_section(); | ||
int rc = ml_cpu_timer_free(timer); | ||
caml_leave_blocking_section(); | ||
if (-1 == rc) | ||
uerror("timer_delete", Nothing); | ||
CAMLreturn(Val_unit); | ||
} | ||
|
||
CAMLprim value ml_cpu_timer_settime(value timer, value interval) { | ||
CAMLparam2(timer, interval); | ||
timer_t *timerid_ptr = timer_t_val(timer); | ||
|
||
if (!timerid_ptr) | ||
unix_error(EINVAL, "timer_settime", Nothing); | ||
|
||
struct itimerspec spec; | ||
|
||
double t = Double_val(interval); | ||
spec.it_interval.tv_sec = (time_t)t; | ||
spec.it_interval.tv_nsec = (t - spec.it_interval.tv_sec) * 1e9; | ||
spec.it_value = spec.it_interval; | ||
|
||
timer_t timerid = *timerid_ptr; | ||
|
||
caml_enter_blocking_section(); | ||
int rc = timer_settime(timerid, 0, &spec, NULL); | ||
caml_leave_blocking_section(); | ||
|
||
if (-1 == rc) | ||
uerror("timer_settime", Nothing); | ||
|
||
CAMLreturn(Val_unit); | ||
} | ||
|
||
CAMLprim value ml_cpu_timer_gettime(value timer) { | ||
CAMLparam1(timer); | ||
timer_t *timerid_ptr = timer_t_val(timer); | ||
|
||
if (!timerid_ptr) | ||
unix_error(EINVAL, "timer_gettime", Nothing); | ||
|
||
timer_t timerid = *timerid_ptr; | ||
struct itimerspec spec; | ||
|
||
caml_enter_blocking_section(); | ||
int rc = timer_gettime(timerid, &spec); | ||
caml_leave_blocking_section(); | ||
if (-1 == rc) | ||
uerror("timer_gettime", Nothing); | ||
|
||
double t = spec.it_value.tv_nsec * 1e-9 + spec.it_value.tv_sec; | ||
CAMLreturn(caml_copy_double(t)); | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.