apc.ml

   1 open Format
   2
   3 let (|>) x f = f x
   4 let (|<) f x = f x
   5
   6 let font = Glut.BITMAP_HELVETICA_12
   7 let draw_string ?(font=font) x y s =
   8   GlPix.raster_pos ~x ~y ();
   9   String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s
  10
  11 module NP = struct
  12   type sysinfo =
  13       { uptime: int64
  14       ; loads: int64 * int64 * int64
  15       ; totalram: int64
  16       ; freeram: int64
  17       ; sharedram: int64
  18       ; bufferram: int64
  19       ; totalswap: int64
  20       ; freeswap: int64
  21       ; procs: int64
  22       }
  23
  24   external get_nprocs : unit -> int = "ml_get_nprocs"
  25   external idletimeofday : Unix.file_descr -> int -> float array
  26     = "ml_idletimeofday"
  27   external sysinfo : unit -> sysinfo = "ml_sysinfo"
  28   external waitalrm : unit -> unit = "ml_waitalrm"
  29   external get_hz : unit -> int = "ml_get_hz"
  30   external setnice : int -> unit = "ml_nice"
  31
  32   let user = 0
  33   let nice = 1
  34   let sys = 2
  35   let idle = 3
  36   let iowait = 4
  37   let intr = 5
  38   let softirq = 6
  39
  40   let hz = get_hz () |> float
  41
  42   let jiffies_to_sec j =
  43     float j /. hz
  44
  45   let nprocs = get_nprocs ()
  46
  47   let rec parse_int_cont s pos =
  48     let slen = String.length s in
  49     let pos =
  50       let rec skipws pos =
  51         if pos = slen
  52         then pos
  53         else
  54           if String.get s pos = ' '
  55         then succ pos |> skipws
  56         else pos
  57       in skipws pos
  58     in
  59     let endpos =
  60       try String.index_from s pos ' '
  61       with Not_found -> slen
  62     in
  63     let i = endpos - pos |> String.sub s pos |> int_of_string in
  64       if endpos = slen
  65       then
  66         `last i
  67       else
  68         `more (i, fun () -> succ endpos |> parse_int_cont s)
  69
  70   let parse_cpul s =
  71     let rec tolist accu = function
  72       | `last i -> i :: accu
  73       | `more (i, f) -> f () |> tolist (i :: accu)
  74     in
  75     let index = String.index s ' ' in
  76     let cpuname = String.sub s 0 index in
  77     let vals = parse_int_cont s (succ index) |> tolist [] in
  78     let vals = List.rev |<
  79         if List.length vals < 7
  80         then
  81           0 :: 0 :: 0 :: 0 :: vals
  82         else
  83           vals
  84     in
  85       cpuname, Array.of_list vals
  86
  87   let parse_stat () =
  88     fun () ->
  89       let ic = open_in "/proc/stat" in
  90       let rec loop i accu =
  91         if i = -1
  92         then List.rev accu
  93         else (input_line ic |> parse_cpul) :: accu |> loop (pred i)
  94       in
  95       let ret = loop nprocs [] in
  96         close_in ic;
  97         ret
  98
  99   let getselfdir () =
 100     try
 101       Filename.dirname |< Unix.readlink "/proc/self/exe"
 102     with exn ->
 103       "./"
 104 end
 105
 106 let niceth nprocs =
 107   for i = 0 to pred nprocs
 108   do
 109     Thread.create
 110       (fun () ->
 111         NP.setnice 20;
 112         let rec loop i = succ i |> loop in loop 0
 113       )
 114       () |> ignore
 115   done
 116
 117 module Args = struct
 118   let banner =
 119     [ "Amazing Piece of Code by insanely gifted programmer, Version 0.90"
 120     ; "Motivation by: gzh and afs"
 121     ; "usage: "
 122     ] |> String.concat "\n"
 123
 124   let freq = ref 1.0
 125   let interval = ref 15.0
 126   let devpath = NP.getselfdir () |> Filename.concat |< "itc" |> ref
 127   let pgrid = ref 10
 128   let sgrid = ref 10
 129   let w = ref 400
 130   let h = ref 200
 131   let verbose = ref false
 132   let delay = ref 0.04
 133   let ksampler = ref true
 134   let barw = ref 100
 135   let bars = ref 100
 136   let sigway = ref true
 137   let niceval = ref 0
 138   let gzh = ref false
 139
 140   let dA tos s {contents=v} = s ^ " (" ^ tos v ^ ")"
 141   let dF = dA string_of_float
 142   let dB = dA string_of_bool
 143   let dI = dA string_of_int
 144   let dS = dA (fun s -> "`" ^ String.escaped s ^ "'")
 145
 146   let pad n s =
 147     let l = String.length s in
 148       if l >= n
 149       then
 150         s
 151       else
 152         let d = String.make n ' ' in
 153           StringLabels.blit ~src:s ~dst:d
 154             ~src_pos:0 ~len:l
 155             ~dst_pos:0;
 156           d
 157
 158   let sF opt r doc =
 159     "-" ^ opt, Arg.Set_float r, pad 9 "<float> " ^ doc |> dF |< r
 160
 161   let sI opt r doc =
 162     "-" ^ opt, Arg.Set_int r, pad 9 "<int> " ^ doc |> dI |< r
 163
 164   let sB opt r doc =
 165     "-" ^ opt, Arg.Set r, pad 9 "" ^ doc |> dB |< r
 166
 167   let sBc opt r doc =
 168     "-" ^ opt, Arg.Clear r, pad 9 "" ^ doc |> dB |< r
 169
 170   let sS opt r doc =
 171     "-" ^ opt, Arg.Set_string r, pad 9 "<string> " ^ doc |> dS |< r
 172
 173   let init () =
 174     Arg.parse
 175       [ sF "f" freq "update frequency"
 176       ; sF "D" delay "refresh delay"
 177       ; sF "i" interval "interval"
 178       ; sI "p" pgrid "pgrid"
 179       ; sI "s" sgrid "sgrid"
 180       ; sI "w" w "width"
 181       ; sI "h" h "height"
 182       ; sI "b" barw "bar width"
 183       ; sI "B" bars "number of CPU bars"
 184       ; sI "n" niceval "value to renice self on init"
 185       ; sS "d" devpath "path to itc device"
 186       ; sBc "k" ksampler "do not show kernel view"
 187       ; sB "v" verbose "verbose"
 188       ; sB "S" sigway "sigwait delay method"
 189       ]
 190       (fun s ->
 191         "don't know what to do with " ^ s |> prerr_endline;
 192         exit 100
 193       )
 194       banner
 195 end
 196
 197 let oohz oohz fn =
 198   let prev = ref 0.0 in
 199     fun () ->
 200       let a = !prev in
 201       let b = Unix.gettimeofday () in
 202         if b -. a > oohz
 203         then
 204           begin
 205             prev := b;
 206             fn ()
 207           end
 208
 209 module Delay = struct
 210   let sighandler signr = ()
 211
 212   let init () =
 213     let () =
 214       Sys.Signal_handle sighandler |> Sys.set_signal Sys.sigalrm;
 215       if !Args.sigway
 216       then
 217         Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigalrm] |> ignore
 218       ;
 219     in
 220     let v = 1e-6 /. !Args.freq in
 221     let t = { Unix.it_interval = v; it_value = v } in
 222     let _ = Unix.setitimer Unix.ITIMER_REAL t in
 223       ()
 224
 225   let delay () =
 226     if !Args.sigway
 227     then NP.waitalrm ()
 228     else
 229       try let _ = Unix.select [] [] [] ~-.1.0 in ()
 230       with Unix.Unix_error (Unix.EINTR, _, _) -> ()
 231 end
 232
 233 module Sampler(T : sig val nsamples : int val freq : float end) =
 234 struct
 235   let nsamples = T.nsamples
 236   let samples = Array.create nsamples 0.0
 237   let head = ref 0
 238   let active = ref 0
 239
 240   let update v n =
 241     let n = min nsamples n in
 242     let rec loop i j =
 243       if j = 0
 244       then ()
 245       else
 246         let i = if i = nsamples then 0 else i in
 247           Array.set samples i v;
 248           loop (succ i) (pred j)
 249     in
 250     let () = loop !head n in
 251     let () = head := (!head + n) mod nsamples in
 252     let () = active := min (!active + n) nsamples in
 253       ()
 254
 255   let getyielder () =
 256     let tail =
 257       let d = !head - !active in
 258         if d < 0
 259         then nsamples + d
 260         else d
 261     in
 262     let ry = ref (fun () -> assert false) in
 263     let rec yield i () =
 264       if i >= !active
 265       then None
 266       else
 267         begin
 268           ry := succ i |> yield;
 269           Some ((i + tail) mod nsamples |> Array.get samples)
 270         end
 271     in
 272       ry := yield 0;
 273       (fun () -> !ry ())
 274
 275   let update t1 t2 i1 i2 =
 276     let d = t2 -. t1 in
 277     let i = i2 -. i1 in
 278     let isamples = truncate (d /. T.freq) in
 279     let l = 1.0 -. (i /. d) in
 280       update l isamples;
 281 end
 282
 283 module type ViewSampler =
 284 sig
 285   val getyielder : unit -> unit -> float option
 286   val update : float -> float -> float -> float -> unit
 287 end
 288
 289 type sampler =
 290     { color : Gl.rgb;
 291       getyielder : unit -> unit -> float option;
 292       update : float -> float -> float -> float -> unit;
 293     }
 294
 295 module type View =
 296 sig
 297   val x : int
 298   val y : int
 299   val w : int
 300   val h : int
 301   val sgrid : int
 302   val pgrid : int
 303   val freq : float
 304   val interval : float
 305   val samplers : sampler list
 306 end
 307
 308 module View(V: sig val w : int val h : int end) = struct
 309   let ww = ref 0
 310   let wh = ref 0
 311   let funcs = ref []
 312
 313   let keyboard ~key ~x ~y =
 314     if key = 27 || key = Char.code 'q'
 315     then exit 0
 316
 317   let add f =
 318     funcs := f :: !funcs
 319
 320   let display () =
 321     GlClear.clear [`color];
 322     List.iter (fun (display, _) -> display ()) !funcs;
 323     Glut.swapBuffers ()
 324
 325   let reshape ~w ~h =
 326     ww := w;
 327     wh := h;
 328     List.iter (fun (_, reshape) -> reshape w h) !funcs;
 329     GlClear.clear [`color];
 330     GlMat.mode `modelview;
 331     GlMat.load_identity ();
 332     GlMat.mode `projection;
 333     GlMat.load_identity ();
 334     GlMat.rotate ~y:1.0 ~angle:180.0 ();
 335     GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
 336     GlMat.scale ~x:2.0 ~y:2.0 ();
 337     Glut.postRedisplay ()
 338
 339   let init () =
 340     let () =
 341       Glut.initDisplayMode ~double_buffer:true ();
 342       Glut.initWindowSize V.w V.h
 343     in
 344     let _ = Glut.createWindow "APC" in
 345       Glut.displayFunc display;
 346       Glut.reshapeFunc reshape;
 347       Glut.keyboardFunc keyboard;
 348       GlDraw.color (1.0, 1.0, 0.0)
 349
 350   let update =
 351     Glut.postRedisplay
 352
 353   let func = Glut.idleFunc
 354
 355   let run = Glut.mainLoop
 356 end
 357
 358 module Bar(T: sig val barw : int val bars : int end) = struct
 359   let nbars = T.bars
 360   let kload = ref 0.0
 361   let iload = ref 0.0
 362   let vw = ref 0
 363   let vh = ref 0
 364   let sw = float T.barw /. float !Args.w
 365   let bw = ref 0
 366   let m = 1
 367   let fw = 3 * Glut.bitmapWidth font (Char.code 'W')
 368
 369   let reshape w h =
 370     vw := w;
 371     vh := h;
 372     bw := (float w *. sw |> truncate) - m;
 373   ;;
 374
 375   let display () =
 376     let kload = min !kload 1.0 |> max 0.0 in
 377     let iload = min !iload 1.0 |> max 0.0 in
 378     let () =
 379       GlDraw.viewport m 0 !bw 15;
 380       GlDraw.color (1.0, 1.0, 1.0);
 381       let kload = 100.0 *. kload in
 382       let iload = 100.0 *. iload in
 383
 384         GlMat.push ();
 385         GlMat.load_identity ();
 386         GlMat.scale ~x:(1.0/.float !bw) ~y:(1.0/.30.0) ();
 387
 388         let ix = !bw / 2 - fw |> float in
 389         let kx = - (fw + !bw / 2) |> float in
 390           sprintf "%5.2f" iload |> draw_string ix 0.0;
 391           sprintf "%5.2f" kload |> draw_string kx 0.0;
 392           GlMat.pop ();
 393     in
 394
 395     let y = 18 in
 396     let h = !vh - 15 - y in
 397     let () = GlDraw.viewport m y !bw h in
 398
 399     let () =
 400       GlMat.push ();
 401       GlMat.load_identity ();
 402       GlMat.rotate ~y:1.0 ~angle:180.0 ();
 403       GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
 404       GlMat.scale ~x:2.0 ~y:(2.0 /. float h) ()
 405     in
 406
 407     let barm = 1 in
 408     let mspace = barm * nbars in
 409     let barh = (h + 66 - mspace / 2) / nbars |> float in
 410     let barm = float barm in
 411     let yb = 0.0 in
 412
 413     let drawbar xl xr load =
 414       let drawquads start lim yb : float =
 415         let rec loop i yb =
 416           if i = lim
 417           then yb
 418           else
 419             let yt = yb +. barh in
 420             let yn = yt +. barm in
 421               GlDraw.vertex2 (xl, yb);
 422               GlDraw.vertex2 (xl, yt);
 423               GlDraw.vertex2 (xr, yt);
 424               GlDraw.vertex2 (xr, yb);
 425               succ i |> loop |< yn
 426         in
 427           GlDraw.begins `quads;
 428           let yt = loop start yb in
 429             GlDraw.ends ();
 430             yt
 431       in
 432       let lim = load *. float nbars |> truncate in
 433       let yb = drawquads 0 lim yb in
 434         GlDraw.color (0.5, 0.5, 0.5);
 435         ignore (drawquads lim nbars yb)
 436     in
 437     let xl = 0.01 in
 438     let xr = 0.49 in
 439       GlDraw.color (1.0, 1.0, 0.0);
 440       drawbar xl xr iload;
 441       let xl = 0.51 in
 442       let xr = 0.99 in
 443         GlDraw.color (1.0, 0.0, 0.0);
 444         drawbar xl xr kload;
 445         GlDraw.color (1.0, 1.0, 1.0);
 446         GlMat.pop ();
 447   ;;
 448
 449   let update kload' iload' =
 450     kload := kload' /. float NP.nprocs;
 451     iload := iload' /. float NP.nprocs;
 452   ;;
 453 end
 454
 455 module Graph (V: View) = struct
 456   let sw = float V.w /. float !Args.w
 457   let sh = float V.h /. float !Args.h
 458   let sx = float V.x /. float V.w
 459   let sy = float V.y /. float V.h
 460   let vw = ref 0
 461   let vh = ref 0
 462   let vx = ref 0
 463   let vy = ref 0
 464   let fw = 3 * Glut.bitmapWidth font (Char.code '%')
 465   let fh = 6
 466   let scale = V.freq /. V.interval
 467   let gridlist =
 468     let base = GlList.gen_lists ~len:1 in
 469       GlList.nth base ~pos:0
 470
 471   let viewport typ =
 472     let x, y, w, h =
 473       match typ with
 474         | `labels -> (!vx, !vy + 5, fw, !vh - 20)
 475         | `graph  -> (!vx + fw + 5, !vy + 5, !vw - fw - 10, !vh - 20)
 476     in
 477       GlDraw.viewport x y w h
 478
 479   let grid () =
 480     let scale = 1.0 /. float V.sgrid in
 481       viewport `graph;
 482       GlDraw.line_width 1.0;
 483       GlDraw.color (0.0, 1.0, 0.0);
 484       GlDraw.begins `lines;
 485       for i = 0 to V.sgrid
 486       do
 487         let x = float i *. scale in
 488         let x = if i = 0 then 0.0009 else x in
 489           GlDraw.vertex ~x ~y:0.0 ();
 490           GlDraw.vertex ~x ~y:1.0 ();
 491       done;
 492       let lim = 100 / V.pgrid in
 493       let () =
 494         for i = 0 to lim
 495         do
 496           let y = (i * V.pgrid |> float) /. 100.0 in
 497           let y = if i = lim then y -. 0.0009 else y in
 498             GlDraw.vertex ~x:0.0 ~y ();
 499             GlDraw.vertex ~x:1.0 ~y ();
 500         done
 501       in
 502       let () =
 503         GlDraw.ends ();
 504         viewport `labels;
 505         GlDraw.color (1.0, 1.0, 1.0);
 506       in
 507       let ohp = 100.0 in
 508         for i = 0 to 100 / V.pgrid
 509         do
 510           let p = i * V.pgrid in
 511           let y = float p /. ohp in
 512           let s = Printf.sprintf "%3d%%" p in
 513             draw_string 1.0 y s
 514         done
 515   ;;
 516
 517   let reshape w h =
 518     let wxsw = float w *. sw
 519     and hxsh = float h *. sh in
 520       vw := wxsw |> truncate;
 521       vh := hxsh |> truncate;
 522       vx := wxsw *. sx |> truncate;
 523       vy := hxsh *. sy |> truncate;
 524       GlList.begins gridlist `compile;
 525       grid ();
 526       GlList.ends ();
 527   ;;
 528
 529   let swap =
 530     Glut.swapBuffers |> oohz !Args.delay;
 531   ;;
 532
 533   let display () =
 534     (* grid (); *)
 535     GlList.call gridlist;
 536     GlDraw.line_width 1.5;
 537     viewport `graph;
 538
 539     let sample sampler =
 540       GlDraw.color sampler.color;
 541       GlDraw.begins `line_strip;
 542       let yield = sampler.getyielder () in
 543       let rec loop last i =
 544         match yield () with
 545           | Some y as opty ->
 546               let x = float i *. scale in
 547                 GlDraw.vertex ~x ~y ();
 548                 loop opty (succ i)
 549           | None -> last, succ i
 550       in
 551       let () =
 552         match loop None 0 with
 553           | None, _ -> ()
 554           | Some y, i ->
 555               let x = float i *. scale in
 556                 GlDraw.vertex ~x ~y ()
 557       in
 558         GlDraw.ends ();
 559     in
 560       List.iter sample V.samplers
 561
 562   let funcs = display, reshape
 563 end
 564
 565 let getplacements w h n barw =
 566   let sr = float n |> sqrt |> ceil |> truncate in
 567   let d = n / sr in
 568   let r = if n mod sr = 0 then 0 else 1 in
 569   let x, y =
 570     if w - barw > h
 571     then
 572       sr + r, d
 573     else
 574       d, sr + r
 575   in
 576   let w' = w - barw in
 577   let h' = h in
 578   let vw = w' / x in
 579   let vh = h' / y in
 580   let rec loop accu i =
 581     if i = n
 582     then accu
 583     else
 584       let yc = i / x in
 585       let xc = i mod x in
 586       let xc = xc * vw + barw in
 587       let yc = yc * vh in
 588         (i, xc, yc) :: accu |> loop |< succ i
 589   in
 590     loop [] 0, vw, vh
 591
 592 let create fd w h =
 593   let module S =
 594       struct
 595         let freq = !Args.freq
 596         let nsamples = !Args.interval /. freq |> ceil |> truncate
 597       end
 598   in
 599   let placements, vw, vh = getplacements w h NP.nprocs !Args.barw in
 600
 601   let iget () = NP.idletimeofday fd NP.nprocs in
 602   let is = iget () in
 603
 604   let kget () =
 605     let gks = NP.parse_stat () in
 606       gks () |> Array.of_list
 607   in
 608   let ks = kget () in
 609
 610   let crgraph (kaccu, iaccu) (i, x, y) =
 611     let module Si = Sampler (S) in
 612     let isampler =
 613       { getyielder = Si.getyielder
 614       ; color = (1.0, 1.0, 0.0)
 615       ; update = Si.update
 616       }
 617     in
 618     let (kcalc, ksampler) =
 619       let module Sc = Sampler (S) in
 620       let sampler =
 621         { getyielder = Sc.getyielder
 622         ; color = (1.0, 0.0, 0.0)
 623         ; update = Sc.update
 624         }
 625       in
 626       let calc =
 627         let i' = if i = NP.nprocs then 0 else succ i in
 628           if !Args.gzh
 629           then
 630             let g ks =
 631               let ks = Array.get ks i' |> snd in
 632               let user = Array.get ks NP.user in
 633               let nice = Array.get ks NP.nice in
 634               let _idle = Array.get ks NP.idle in
 635                 NP.jiffies_to_sec (nice - user)
 636             in
 637             let i1 = g ks |> ref in
 638               fun ks t1 t2 ->
 639                 let i2 = g ks in
 640                 let i1' = !i1
 641                 and i2' = i2 in
 642                   i1 := i2;
 643                   0.0, 1.0 -. (i2' -. i1')
 644           else
 645             let n = NP.idle in
 646             let g ks = Array.get ks i' |> snd |> Array.get |< n in
 647             let i1 = g ks |> ref in
 648               fun ks t1 t2 ->
 649                 let i2 = g ks in
 650                 let i1' = NP.jiffies_to_sec !i1
 651                 and i2' = NP.jiffies_to_sec i2 in
 652                   i1 := i2;
 653                   i1', i2'
 654       in
 655         calc, sampler
 656     in
 657     let module V =
 658         struct
 659           let x = x
 660           let y = y
 661           let w = vw
 662           let h = vh
 663           let freq = S.freq
 664           let interval = !Args.interval
 665           let pgrid = !Args.pgrid
 666           let sgrid = !Args.sgrid
 667           let samplers =
 668             if !Args.ksampler
 669             then [isampler; ksampler]
 670             else [isampler]
 671         end
 672     in
 673     let module Graph = Graph (V) in
 674     let icalc =
 675       let i1 = Array.get is i |> ref in
 676         fun is t1 t2 ->
 677           let i2 = Array.get is i in
 678           let result =
 679             if i2 = 0.0
 680             then
 681               let () = i1 := !i1 +. (t2 -. t1) in
 682                 t1, t2
 683             else
 684               let i1' = !i1 in
 685                 i1 := i2;
 686                 i1', i2
 687           in
 688             result
 689     in
 690     let kaccu =
 691       if !Args.ksampler
 692       then (i, kcalc, ksampler, Graph.funcs) :: kaccu
 693       else kaccu
 694     in
 695       kaccu, (i, icalc, isampler, Graph.funcs) :: iaccu
 696   in
 697   let kl, il = List.fold_left crgraph ([], []) placements in
 698     ((if kl == [] then (fun () -> [||]) else kget), kl), (iget, il)
 699
 700 let opendev path =
 701   try
 702     Unix.openfile path [Unix.O_RDONLY] 0
 703   with
 704     | Unix.Unix_error (Unix.ENODEV, s1, s2) ->
 705         eprintf "Could not open ITC device %S:\n%s(%s): %s)\n"
 706           path s1 s2 |< Unix.error_message Unix.ENODEV;
 707         eprintf "(perhaps the module is not loaded?)@.";
 708         exit 100
 709
 710     | Unix.Unix_error (Unix.ENOENT, s1, s2) ->
 711         eprintf "Could not open ITC device %S:\n%s(%s): %s\n"
 712           path s1 s2 |< Unix.error_message Unix.ENOENT;
 713         exit 100
 714
 715 let main () =
 716   let _ = Glut.init [|""|] in
 717   let () = Args.init () in
 718   let () = Delay.init () in
 719   let () = if !Args.niceval != 0 then NP.setnice !Args.niceval in
 720   let () = if !Args.gzh then niceth NP.nprocs in
 721   let w = !Args.w
 722   and h = !Args.h in
 723   let fd = opendev !Args.devpath in
 724   let module FullV = View (struct let w = w let h = h end) in
 725   let () = FullV.init () in
 726   let (kget, kfuncs), (iget, ifuncs) = create fd w h in
 727   let module Bar =
 728     Bar (struct let barw = !Args.barw let bars = !Args.bars end)
 729   in
 730   let () =
 731     FullV.add (Bar.display, Bar.reshape);
 732     List.iter (fun (_, _, _, gfuncs) -> FullV.add gfuncs) kfuncs;
 733     List.iter (fun (_, _, _, gfuncs) -> FullV.add gfuncs) ifuncs;
 734   in
 735   let rec loop t1 () =
 736     let t2 = Unix.gettimeofday () in
 737     let d = t2 -. t1 in
 738       if d >= !Args.freq
 739       then
 740         let is = iget () in
 741         let ks = kget () in
 742         let rec loop2 load s = function
 743           | [] -> load
 744           | (nr, calc, sampler, _) :: rest ->
 745               let i1, i2 = calc s t1 t2 in
 746               let () =
 747                 if !Args.verbose
 748                 then
 749                   ("cpu load(" ^ string_of_int nr ^ "): "
 750                     ^ (100.0 -. ((i2 -. i1) /. d) *. 100.0 |> string_of_float)
 751                   |> prerr_endline)
 752               in
 753               let load = load +. (1.0 -. ((i2 -. i1) /. d)) in
 754                 sampler.update t1 t2 i1 i2;
 755                 loop2 load s rest
 756         in
 757         let iload = loop2 0.0 is ifuncs in
 758         let kload = loop2 0.0 ks kfuncs in
 759           Bar.update kload iload;
 760           FullV.update ();
 761           FullV.func (Some (loop t2))
 762       else
 763         Delay.delay ()
 764   in
 765     FullV.func (Some (Unix.gettimeofday () |> loop));
 766     FullV.run ()
 767
 768 let _ =
 769   try main ()
 770   with
 771     | Unix.Unix_error (e, s1, s2) ->
 772         eprintf "%s(%s): %s@." s1 s2 |< Unix.error_message e
 773
 774     | exn ->
 775         Printexc.to_string exn |> eprintf "Exception: %s@."