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
44 ; softirq
= -.a
.softirq
54 ; iowait
= a
.iowait
*. s
56 ; softirq
= a
.softirq
*. s
61 { all
= a
.all
+. b
.all
62 ; user
= a
.user
+. b
.user
63 ; nice
= a
.nice
+. b
.nice
64 ; sys
= a
.sys
+. b
.sys
65 ; idle
= a
.idle
+. b
.idle
66 ; iowait
= a
.iowait
+. b
.iowait
67 ; intr
= a
.intr
+. b
.intr
68 ; softirq
= a
.softirq
+. b
.softirq
75 ; loads
: int64
* int64
* int64
86 external get_nprocs
: unit -> int = "ml_get_nprocs"
87 external idletimeofday
: Unix.file_descr
-> int -> float array
89 external sysinfo
: unit -> sysinfo
= "ml_sysinfo"
90 external waitalrm
: unit -> unit = "ml_waitalrm"
91 external get_hz
: unit -> int = "ml_get_hz"
92 external setnice
: int -> unit = "ml_nice"
93 external delay
: float -> unit = "ml_delay"
94 external is_winnt
: unit -> bool = "ml_is_winnt"
96 let winnt = is_winnt
()
106 let hz = get_hz
() |> float
108 let jiffies_to_sec j
=
112 let parse_uptime () =
113 let ic = open_in
"/proc/uptime" in
114 let vals = Scanf.fscanf
ic "%f %f" (fun u i
-> (u
, i
)) in
119 let nprocs = get_nprocs
()
121 let rec parse_int_cont s pos
=
122 let slen = String.length s
in
128 if String.get s
pos = ' '
129 then succ
pos |> skipws
134 try String.index_from s
pos ' '
135 with Not_found
-> slen
137 let i = endpos - pos |> String.sub s
pos
144 `more
(i, fun () -> succ
endpos |> parse_int_cont s
)
148 let rec tolist accu
= function
149 | `last
i -> i :: accu
150 | `more
(i, f
) -> f
() |> tolist (i :: accu
)
152 let index = String.index s ' '
in
153 let cpuname = String.sub s
0 index in
154 let vals = parse_int_cont s
(succ
index) |> tolist [] in
155 let vals = List.rev
|<
156 if List.length
vals < 7
158 0.0 :: 0.0 :: 0.0 :: 0.0 :: vals
162 cpuname, Array.of_list
vals
169 let ia = idletimeofday
Unix.stdin
nprocs in
170 let rec convert accu total n
=
174 let a = "cpu", Array.make
7 t in
177 let i = Array.get
ia n
in
178 let total = total +. i in
179 let v = "cpu" ^ string_of_int n
, Array.make
7 i in
180 convert |< v :: accu
|< total |< succ n
185 let ic = open_in
"/proc/stat" in
186 let rec loop i accu
=
189 else (input_line
ic |> parse_cpul) :: accu
|> loop (pred
i)
191 let ret = loop nprocs [] in
198 Filename.dirname
|< Unix.readlink
"/proc/self/exe"
206 [ "Amazing Piece of Code by insanely gifted programmer, Version 0.98a"
207 ; "Motivation by: gzh and afs"
209 ] |> String.concat
"\n"
212 let interval = ref 15.0
213 let devpath = NP.getselfdir () |> Filename.concat
|< "itc" |> ref
218 let verbose = ref false
220 let ksampler = ref true
223 let sigway = ref true
226 let scalebar = ref false
228 let debug = ref false
230 let uptime = ref false
232 let labels = ref true
233 let mgrid = ref false
234 let sepstat = ref false
237 let l = String.length s
in
242 let d = String.make n ' '
in
243 StringLabels.blit ~src
:s ~dst
:d
249 let sooo b
= if b
then "on" else "off"
250 let dA tos s
{contents
=v} = s ^
" (" ^ tos
v ^
")"
251 let dF = dA |< sprintf
"%4.2f"
254 let dI = dA string_of_int
255 let dS = dA (fun s
-> "`" ^
String.escaped s ^
"'")
258 "-" ^ opt
, Arg.Set_float r
, pad 9 "<float> " ^ doc
|> dF |< r
261 "-" ^ opt
, Arg.Set_int r
, pad 9 "<int> " ^ doc
|> dI |< r
264 "-" ^ opt
, Arg.Set r
, pad 9 "" ^ doc
|> dB |< r
267 "-" ^ opt
, Arg.Set_string r
, pad 9 "<string> " ^ doc
|> dS |< r
272 "-" ^ opt
, Arg.Clear r
, pad 9 "" ^ doc
|> dB |< r
274 "-" ^ opt
, Arg.Set r
, pad 9 "" ^ doc
|> dcB |< r
278 [ sF "f" freq "sampling frequency in seconds"
279 ; sF "D" delay "refresh delay in seconds"
280 ; sF "i" interval "history interval in seconds"
281 ; sI "p" pgrid "percent grid items"
282 ; sI "s" sgrid "history grid items"
285 ; sI "b" barw "bar width"
286 ; sI "B" bars "number of CPU bars"
287 ; sI "n" niceval "value to renice self on init"
288 ; sI "t" timer "timer frequency in herz"
289 ; sS "d" devpath "path to itc device"
290 ; fB "k" ksampler |< "kernel sampler"
291 ^
(if NP.winnt then "" else " (`/proc/[stat|uptime]')")
292 ; fB "g" gzh "gzh way (does not quite work yet)"
294 "`uptime' instead of `stat' as kernel sampler (UP only)"
295 ; sB "v" verbose "verbose"
296 ; fB "S" sigway "sigwait delay method"
297 ; fB "C" sepstat "separate sys/nice/intr/iowait values (kernel sampler)"
298 ; fB "c" scalebar "constant bar width"
299 ; fB "P" poly "filled area instead of lines"
300 ; fB "I" icon "icon (hack)"
301 ; fB "l" labels "labels"
302 ; fB "m" mgrid "moving grid"
309 let nixopts = ["-n"; "-u"; "-d"; "-I"; "-S"; "-g"] in
310 prerr_endline
"Only kernel sampler is available on Windows";
311 List.filter
(fun (s
, _
, _
) -> List.mem s
nixopts |> not
) opts
318 "don't know what to do with " ^ s
|> prerr_endline
;
330 let rec furious_cycle i =
331 if not
!stop && i > 0
332 then pred
i |> furious_cycle
333 else (i, Unix.gettimeofday
())
338 let it = { Unix.it_interval
= t; it_value
= t } in
346 let sign = Sys.sigalrm
in
347 let oldh = Sys.signal
sign |< Sys.Signal_handle
handler in
348 let oldi = Unix.setitimer
Unix.ITIMER_REAL
it in
349 let oldbp = Unix.sigprocmask
Unix.SIG_BLOCK
[sign] in
350 let () = NP.waitalrm
() in
351 let () = stop := false in
352 let oldup = Unix.sigprocmask
Unix.SIG_UNBLOCK
[sign] in
353 let t1 = Unix.gettimeofday
() in
354 let n, t2
= furious_cycle max_int
in
355 let () = refdt := t2
-. t1 in
356 let () = lim := tries * (max_int
- n) in
357 let () = if verbose then
359 printf
"Completed %d iterations in %f seconds@." !lim !refdt
361 let _ = Unix.sigprocmask
Unix.SIG_UNBLOCK
oldup in
362 let _ = Unix.setitimer
Unix.ITIMER_REAL
oldi in
363 let _ = Unix.sigprocmask
Unix.SIG_BLOCK
oldbp in
364 let _ = Sys.signal
sign oldh in
374 let _, t2
= furious_cycle !lim in
377 if !Args.debug && !l > 10
380 printf
"Completed %d iterations in %f seconds load %f@."
381 !lim dt |< !refdt /. dt;
388 Unix.gettimeofday
() |> loop
390 let _ = Thread.create
thf () in
396 let prev = ref 0.0 in
399 let b = Unix.gettimeofday
() in
408 module Delay
= struct
409 let sighandler signr
= ()
411 let winfreq = ref 0.0
416 winfreq := 1.0 /. float freq
419 Sys.Signal_handle
sighandler |> Sys.set_signal
Sys.sigalrm
;
422 let l = if gzh then [Sys.sigprof
; Sys.sigvtalrm
] else [] in
423 Unix.sigprocmask
Unix.SIG_BLOCK
|< Sys.sigalrm
:: l |> ignore
;
426 let v = 1.0 /. float freq in
427 let t = { Unix.it_interval
= v; it_value
= v } in
428 let _ = Unix.setitimer
Unix.ITIMER_REAL
t in
443 try let _ = Unix.select
[] [] [] ~
-.1.0 in ()
444 with Unix.Unix_error
(Unix.EINTR
, _, _) -> ()
452 getyielder
: unit -> unit -> float option;
453 update
: float -> float -> float -> float -> unit;
456 module Sampler
(T
: sig val nsamples
: int val freq : float end) =
458 let nsamples = T.nsamples + 1
459 let samples = Array.create
nsamples 0.0
465 let n = min
nsamples n in
470 let i = if i = nsamples then 0 else i in
471 Array.set
samples i v;
472 loop (succ
i) (pred j
)
474 let () = loop !head n in
475 let () = head := (!head + n) mod nsamples in
476 let () = active := min
(!active + n) nsamples in
482 let d = !head - !active in
487 let ry = ref (fun () -> assert false) in
493 ry := succ
i |> yield;
494 Some
((i + tail) mod nsamples |> Array.get
samples)
501 let update t1 t2 i1 i2
=
504 let isamples = d /. T.freq |> truncate
in
505 let l = 1.0 -. (i /. d) in
510 module type ViewSampler
=
512 val getyielder : unit -> unit -> float option
513 val update : float -> float -> float -> float -> unit
526 val samplers
: sampler list
529 module View
(V
: sig val w : int val h : int end) = struct
534 let keyboard ~key ~x ~y
=
535 if key
= 27 || key
= Char.code 'q'
540 funcs := dri
:: !funcs
544 GlClear.clear
[`color
];
545 List.iter
(fun (display, _, _) -> display ()) !funcs;
552 List.iter
(fun (_, reshape, _) -> reshape w h) !funcs;
553 GlClear.clear
[`color
];
554 GlMat.mode `modelview
;
555 GlMat.load_identity
();
556 GlMat.mode `projection
;
557 GlMat.load_identity
();
558 GlMat.rotate ~y
:1.0 ~angle
:180.0 ();
559 GlMat.translate ~x
:~
-.1.0 ~y
:~
-.1.0 ();
560 GlMat.scale ~x
:2.0 ~y
:2.0 ();
561 Glut.postRedisplay
()
566 Glut.initDisplayMode ~double_buffer
:true ();
567 Glut.initWindowSize
V.w V.h
569 let winid = Glut.createWindow
"APC" in
570 Glut.displayFunc
display;
571 Glut.reshapeFunc
reshape;
572 Glut.keyboardFunc
keyboard;
573 GlDraw.color
(1.0, 1.0, 0.0);
577 let inc () = List.iter
(fun (_, _, inc) -> inc ()) !funcs
578 let update = Glut.postRedisplay
579 let func = Glut.idleFunc
580 let run = Glut.mainLoop
583 module Bar
(T
: sig val barw : int val bars : int end) = struct
585 let kload = ref zero_stat
586 let iload = ref zero_stat
589 let sw = float T.barw /. float !Args.w
592 let nrcpuscale = 1.0 /. float NP.nprocs
593 let fw = 3 * Glut.bitmapWidth
font (Char.code 'W'
)
595 let base = GlList.gen_lists ~len
:2 in
596 GlList.nth
base ~
pos:0,
597 GlList.nth
base ~
pos:1
606 let xl, xr
= getlr ki
in
608 let h = !vh - 15 - y in
609 let () = GlDraw.viewport
m y !bw h in
612 GlMat.load_identity
();
613 GlMat.rotate ~
y:1.0 ~angle
:180.0 ();
614 GlMat.translate ~x
:~
-.1.0 ~
y:~
-.1.0 ();
615 GlMat.scale ~x
:2.0 ~
y:(2.0 /. float h) ()
618 let mspace = barm * nbars in
619 let barh = (h + 66 - mspace / 2) / nbars |> float in
620 let barm = float barm in
625 let yt = yb
+. barm in
626 let yn = yt +. barh in
627 GlDraw.vertex2
(xl, yb
);
628 GlDraw.vertex2
(xl, yt);
629 GlDraw.vertex2
(xr
, yt);
630 GlDraw.vertex2
(xr
, yb
);
633 GlDraw.color
(0.0, 0.0, 0.0);
634 GlDraw.begins `quads
;
646 (float w *. sw |> truncate
) - m
651 GlList.begins
ksepsl `compile
;
655 GlList.begins isepsl `compile
;
660 let drawseps = function
661 | `k
-> GlList.call
ksepsl
662 | `
i -> GlList.call isepsl
666 let kload = scale_stat !kload nrcpuscale in
667 let iload = scale_stat !iload nrcpuscale in
668 let kload_all = min
(1.0 -. kload.all
) 1.0 |> max
0.0 in
669 let iload_all = min
(1.0 -. iload.all
) 1.0 |> max
0.0 in
670 let () = GlDraw.viewport
m 0 !bw 15 in
672 GlDraw.color
(1.0, 1.0, 1.0);
673 let kload_all = 100.0 *. kload_all in
674 let iload_all = 100.0 *. iload_all in
677 GlMat.load_identity
();
678 GlMat.scale ~x
:(1.0/.float !bw) ~
y:(1.0/.30.0) ()
680 let ix = !bw / 2 - fw |> float in
681 let kx = - (fw + !bw / 2) |> float in
682 let () = sprintf
"%5.2f" iload_all |> draw_string ix 0.0 in
683 let () = sprintf
"%5.2f" kload_all |> draw_string kx 0.0 in
684 let () = GlMat.pop
() in ()
688 let h = !vh - 15 - y in
689 let () = GlDraw.viewport
m y !bw h in
692 GlMat.load_identity
();
693 GlMat.rotate ~
y:1.0 ~angle
:180.0 ();
694 GlMat.translate ~x
:~
-.1.0 ~
y:~
-.1.0 ();
695 GlMat.scale ~x
:2.0 ~
y:(2.0 /. float h) ()
698 let xl, xr
= getlr ki
in
700 GlDraw.begins `quads
;
701 GlDraw.vertex2
(xl, yb
);
702 GlDraw.vertex2
(xl, yt);
703 GlDraw.vertex2
(xr
, yt);
704 GlDraw.vertex2
(xr
, yb
);
707 let fold yb
(color
, load
) =
710 let () = GlDraw.color color
in
711 let yt = yb
+. float h *. load
in
712 let () = drawquad yb
yt in
717 let yb = List.fold_left
fold 0.0 cl
in
718 let () = GlDraw.color
(0.5, 0.5, 0.5) in
720 let () = drawquad yb yt in
721 let () = drawseps ki
in
728 [ (1.0, 1.0, 0.0), kload.user
729 ; (0.0, 0.0, 1.0), kload.nice
730 ; (1.0, 0.0, 0.0), kload.sys
731 ; (1.0, 1.0, 1.0), kload.intr
732 ; (0.75, 0.5, 0.5), (1.0 -. kload.iowait) -. kload.all
735 aux `k
[ (1.0, 0.0, 0.0), 1.0 -. kload.idle ]
737 let () = aux `
i [ (1.0, 1.0, 0.0), 1.0 -. iload.all
] in
741 let update delta'
kload'
iload'
=
742 let delta = 1.0 /. delta'
in
743 kload := scale_stat kload'
delta;
744 iload := scale_stat iload'
delta;
748 module Graph
(V
: View
) = struct
749 let ox = if !Args.scalebar then 0 else !Args.barw
750 let sw = float V.w /. float (!Args.w - ox)
751 let sh = float V.h /. float !Args.h
752 let sx = float (V.x
- ox) /. float V.w
753 let sy = float V.y /. float V.h
758 let scale = V.freq /. V.interval
759 let gscale = 1.0 /. float V.sgrid
764 then 3 * Glut.bitmapWidth
font (Char.code '
%'
), 20
768 let base = GlList.gen_lists ~len
:1 in
769 GlList.nth
base ~
pos:0
772 let ox = if !Args.scalebar then 0 else !Args.barw in
775 | `
labels -> (!vx + ox, !vy + 5, fw, !vh - fh
)
776 | `graph
-> (!vx + fw + 5 + ox, !vy + 5, !vw - fw - 10, !vh - fh
)
778 GlDraw.viewport x y w h;
784 let x = if i = 0 then 0.0009 else float i *. gscale in
785 GlDraw.vertex ~
x ~
y:0.0 ();
786 GlDraw.vertex ~
x ~
y:1.0 ();
792 GlDraw.line_width
1.0;
793 GlDraw.color
(0.0, 1.0, 0.0);
794 GlDraw.begins `lines
;
798 GlDraw.vertex2
(0.0009, 0.0);
799 GlDraw.vertex2
(0.0009, 1.0);
800 GlDraw.vertex2
(1.0000, 0.0);
801 GlDraw.vertex2
(1.0000, 1.0);
807 let lim = 100 / V.pgrid in
810 let y = (i * V.pgrid |> float) /. 100.0 in
811 let y = if i = lim then y -. 0.0009 else y in
812 GlDraw.vertex ~
x:0.0 ~
y ();
813 GlDraw.vertex ~
x:1.0 ~
y ();
816 let () = GlDraw.ends
() in
821 GlDraw.color
(1.0, 1.0, 1.0);
823 for i = 0 to 100 / V.pgrid
825 let p = i * V.pgrid in
826 let y = float p /. ohp in
827 let s = Printf.sprintf
"%3d%%" p in
834 let wxsw = float (w - ox) *. sw
835 and hxsh
= float h *. sh in
836 vw := wxsw |> truncate
;
837 vh := hxsh
|> truncate
;
838 vx := wxsw *. sx |> truncate
;
839 vy := hxsh
*. sy |> truncate
;
840 GlList.begins
gridlist `compile
;
846 Glut.swapBuffers
|> oohz !Args.delay;
849 let inc () = incr
nsamples
852 GlDraw.line_width
1.0;
853 GlDraw.color
(0.0, 1.0, 0.0);
854 GlDraw.begins `lines
;
856 ((pred
!nsamples |> float) *. scale /. gscale |> modf
|> fst
) *. gscale
858 for i = 0 to pred
V.sgrid
860 let x = offset +. float i *. gscale in
861 GlDraw.vertex ~
x ~
y:0.0 ();
862 GlDraw.vertex ~
x ~
y:1.0 ();
868 GlList.call
gridlist;
870 if !Args.mgrid then mgrid ();
871 GlDraw.line_width
1.5;
874 GlDraw.color sampler
.color
;
877 then GlDraw.begins `line_strip
880 GlDraw.begins `polygon
;
881 GlDraw.vertex2
(0.0, 0.0);
884 let yield = sampler
.getyielder () in
885 let rec loop last
i =
888 let x = float i *. scale in
889 GlDraw.vertex ~
x ~
y ();
897 let x = float (pred
i) *. scale in
898 GlDraw.vertex ~
x ~
y:0.0 ()
903 List.iter
sample V.samplers
;
906 let funcs = display, reshape, inc
909 let getplacements w h n barw =
910 let sr = float n |> sqrt
|> ceil
|> truncate
in
912 let r = if n mod sr = 0 then 0 else 1 in
924 let rec loop accu
i =
930 let xc = xc * vw + barw in
932 (i, xc, yc) :: accu
|> loop |< succ
i
940 let freq = !Args.freq
941 let nsamples = !Args.interval /. freq |> ceil
|> truncate
944 let placements, vw, vh = getplacements w h NP.nprocs !Args.barw in
946 let iget () = NP.idletimeofday fd
NP.nprocs in
950 let gks = NP.parse_stat () in
951 gks () |> Array.of_list
955 let crgraph (kaccu
, iaccu
, gaccu
) (i, x, y) =
956 let module Si
= Sampler
(S
) in
958 { getyielder = Si.getyielder
959 ; color
= (1.0, 1.0, 0.0)
963 let (kcalc
, ksampler) =
964 let module Sc
= Sampler
(S
) in
966 { getyielder = Sc.getyielder
967 ; color
= (1.0, 0.0, 0.0)
975 let f d'
= d := d'
in
976 let () = Gzh.gen f in
978 { zero_stat with all
= !d }
982 let (u1
, i1
) = NP.parse_uptime () in
986 let (u2
, i2
) = NP.parse_uptime () in
988 and di
= i2
-. !i1
in
991 { zero_stat with all
= di
/. du }
993 let i'
= if i = NP.nprocs then 0 else succ
i in
994 let g ks n = Array.get
ks i'
|> snd
|> Array.get
|< n in
996 let user = g ks NP.user
997 and nice = g ks NP.nice
998 and sys = g ks NP.sys
999 and idle = g ks NP.idle
1000 and iowait = g ks NP.idle
1001 and intr = g ks NP.intr
1002 and softirq = g ks NP.softirq in
1008 "user=%f nice=%f sys=%f iowait=%f intr=%f softirq=%f@."
1027 let i1 = ref (gall ks) in
1030 let diff = add_stat i2 (neg_stat !i1) in
1043 let interval = !Args.interval
1044 let pgrid = !Args.pgrid
1045 let sgrid = !Args.sgrid
1048 then [isampler; ksampler]
1052 let module Graph
= Graph
(V
) in
1054 let i1 = Array.get
is i |> ref in
1056 let i2 = Array.get
is i in
1057 if classify_float
i2 = FP_infinite
1059 { zero_stat with all
= t2
-. t1 }
1063 { zero_stat with all
= i2 -. i1'
}
1067 then (i, kcalc
, ksampler) :: kaccu
1070 kaccu, (i, icalc, isampler) :: iaccu
, Graph.funcs :: gaccu
1072 let kl, il
, gl
= List.fold_left
crgraph ([], [], []) placements in
1073 ((if kl == [] then (fun () -> [||]) else kget), kl), (iget, il
), gl
1082 Unix.openfile path
[Unix.O_RDONLY
] 0
1084 | Unix.Unix_error
(Unix.ENODEV
, s1
, s2
) ->
1085 eprintf
"Could not open ITC device %S:\n%s(%s): %s)\n"
1086 path s1 s2
|< Unix.error_message
Unix.ENODEV
;
1087 eprintf
"(perhaps the module is not loaded?)@.";
1090 | Unix.Unix_error
(Unix.ENOENT
, s1
, s2
) ->
1091 eprintf
"Could not open ITC device %S:\n%s(%s): %s\n"
1092 path s1 s2
|< Unix.error_message
Unix.ENOENT
;
1095 | Unix.Unix_error
(error
, s1
, s2
) ->
1096 eprintf
"Could not open ITC device %S:\n%s(%s): %s\n"
1097 path s1 s2
|< Unix.error_message error
;
1098 eprintf
"(perhaps modules is already in use?)@.";
1102 eprintf
"Could not open ITC device %S:\n%s\n"
1103 path
|< Printexc.to_string exn
;
1108 let module X
= struct external seticon : string -> unit = "ml_seticon" end in
1110 let data = String.create |< 32*len + 2*4 in
1115 and a = Char.chr
a in
1116 let s = String.create len in
1122 x + 0 |> String.set
s |< b;
1123 x + 1 |> String.set
s |< g;
1124 x + 2 |> String.set
s |< r;
1125 x + 3 |> String.set
s |< a;
1131 let el = line 0x00 0x00 0x00 0xff
1132 and kl = line 0xff 0x00 0x00 0xff
1133 and il
= line 0xff 0xff 0x00 0xff in
1135 let src = l and dst
= data and src_pos
= 0 in
1136 let rec loop n dst_pos
=
1140 StringLabels.blit ~
src ~src_pos ~dst ~dst_pos ~
len;
1141 pred
n |> loop |< dst_pos
+ len
1144 (ey
- sy) |> loop |< (32 - ey
) * len + 4*2
1146 fun ~
iload ~
kload ->
1147 let iy = iload *. 32.0 |> ceil
|> truncate
|> max
0 |> min
32
1148 and ky
= kload *. 32.0 |> ceil
|> truncate
|> max
0 |> min
32 in
1151 then (fill kl 0 ky
; fill il ky
iy; iy)
1152 else (fill kl 0 ky
; ky
)
1159 let _ = Glut.init [|""|] in
1160 let () = Args.init () in
1164 "detected " ^ string_of_int
NP.nprocs ^
" CPUs" |> print_endline
1166 let () = if !Args.gzh then Gzh.init !Args.verbose in
1167 let () = Delay.init !Args.timer !Args.gzh in
1168 let () = if !Args.niceval != 0 then NP.setnice
!Args.niceval in
1171 let fd = opendev !Args.devpath in
1172 let module FullV
= View
(struct let w = w let h = h end) in
1173 let _winid = FullV.init () in
1174 let (kget, kfuncs
), (iget, ifuncs
), gl
= create fd w h in
1176 List.iter
FullV.add gl
;
1180 Bar
(struct let barw = !Args.barw let bars = !Args.bars end)
1182 FullV.add (Bar.display, Bar.reshape, fun _ -> ());
1187 let seticon = if !Args.icon then seticon () else fun ~
iload ~
kload -> () in
1188 let rec loop t1 () =
1189 let t2 = Unix.gettimeofday
() in
1190 let dt = t2 -. t1 in
1195 let rec loop2 load
sample = function
1197 | (nr
, calc, sampler) :: rest
->
1198 let cpuload = calc sample t1 t2 in
1199 let thisload = 1.0 -. (cpuload.all
/. dt) in
1200 let thisload = max
0.0 thisload in
1204 ("cpu load(" ^ string_of_int nr ^
"): "
1205 ^
(thisload *. 100.0 |> string_of_float
)
1208 let load = add_stat load cpuload in
1209 sampler.update t1 t2 0.0 load.all
;
1210 loop2 load sample rest
1212 let iload = loop2 zero_stat is ifuncs
in
1213 let kload = loop2 zero_stat ks kfuncs
in
1217 iload.all
|> string_of_float
|> prerr_endline
;
1218 kload.all
|> string_of_float
|> prerr_endline
;
1221 seticon ~
iload:iload.all ~
kload:kload.all
;
1222 bar_update dt kload iload;
1225 FullV.func (Some
(loop t2))
1229 FullV.func (Some
(Unix.gettimeofday
() |> loop));
1236 | Unix.Unix_error
(e
, s1
, s2
) ->
1237 eprintf
"%s(%s): %s@." s1 s2
|< Unix.error_message e
1240 Printexc.to_string exn
|> eprintf
"Exception: %s@."