Source file `netsys_impl_util.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(* $Id$ *)

(* this & that *)

open Netsys_types

let rec restart f arg =
  try 
    f arg
  with
  | Unix.Unix_error(Unix.EINTR,_,_) ->
    restart f arg



let restart_tmo f tmo =
  let t0 = Unix.gettimeofday() in
  let rec tryagain t_elapsed =
    let tmo' = tmo -. t_elapsed in
    try
      f (max tmo' 0.0)
    with
    | Unix.Unix_error(Unix.EINTR,_,_) ->
      let t1 = Unix.gettimeofday() in
      tryagain (t1 -. t0)
  in
  if tmo > 0.0 then
    tryagain 0.0
  else
    restart f tmo


let max_int_32 = 
  1073741823


let slice_time_ms f tmo =
  (* We assume f is called with a timeout argument [f tmo0] where the argument
     is given in milliseconds up to max_int_32. [tmo] is the requested timeout
     as float in seconds. The task is to call [f] several times with an int
     argument until [f] returns a non-None result, or until [tmo] has elapsed.
     Negative values are allowed and interpreted as infinite timeout.
  *)
  let tmo_ms = tmo *. 1000.0 in
  let max_int64_as_float = Int64.to_float Int64.max_int in
  let max_int_as_int64 = Int64.of_int max_int_32 in
  if tmo < 0.0 || tmo_ms >= max_int64_as_float then
    f (-1)
  else (
    let remaining_tmo_ms = ref (Int64.of_float tmo_ms) in
    let result = ref None in
    while !result = None && !remaining_tmo_ms > 0L do
      if !remaining_tmo_ms > max_int_as_int64 then (
        result := f max_int_32;
        remaining_tmo_ms := Int64.sub !remaining_tmo_ms max_int_as_int64
      )
      else (
        result := f (Int64.to_int !remaining_tmo_ms);
        remaining_tmo_ms := 0L;
      )
    done;
    !result
  )


let mem_sorted_array x a =
  let rec search l h =
    if l < h then (
      let m = (l+h) / 2 in
      let r = compare x a.(m) in
      if r = 0 then
        true
      else
      if r < 0 then
        search l m
      else
        search (m+1) h
    )
    else false
  in
  search 0 (Array.length a)


let tbuffer_length =
  function
  | `Bytes u
  | `String u ->
    Bytes.length u
  | `Memory u ->
    Bigarray.Array1.dim u

let tstring_length =
  function
  | `Bytes u ->
    Bytes.length u
  | `String u ->
    String.length u
  | `Memory u ->
    Bigarray.Array1.dim u