From 51e5068e961a021e77c0e03a522ada3432123515 Mon Sep 17 00:00:00 2001 From: malc Date: Sun, 8 Jul 2007 17:33:53 +0400 Subject: [PATCH] v0.90 --- FILES | 10 + OMakefile | 50 ++++ README | 80 ++++++ Thanks | 5 + apc.ml | 775 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ build.sh | 10 + ml_apc.c | 139 +++++++++++ mod/Makefile | 48 ++++ mod/OMakefile | 9 + mod/itc-mod.c | 286 ++++++++++++++++++++++ 10 files changed, 1412 insertions(+) create mode 100644 FILES create mode 100644 OMakefile create mode 100644 README create mode 100644 Thanks create mode 100644 apc.ml create mode 100755 build.sh create mode 100644 ml_apc.c create mode 100644 mod/Makefile create mode 100644 mod/OMakefile create mode 100644 mod/itc-mod.c diff --git a/FILES b/FILES new file mode 100644 index 0000000..d89429d --- /dev/null +++ b/FILES @@ -0,0 +1,10 @@ +apc.ml +OMakefile +mod/Makefile +mod/OMakefile +mod/itc-mod.c +ml_apc.c +build.sh +README +Thanks +FILES diff --git a/OMakefile b/OMakefile new file mode 100644 index 0000000..029cf36 --- /dev/null +++ b/OMakefile @@ -0,0 +1,50 @@ +version = 0.90 + +ocaml-includes = -I +lablGL + +ocamlc-cflags += -g $(ocaml-includes) -thread +ocamlopt-cflags += $(ocaml-includes) -thread + +ocamlc-lflags += -g $(ocaml-includes) -thread +ocamlopt-lflags += $(ocaml-includes) -thread + +ocaml-libs = unix lablgl lablglut threads +ocamlc-libs = $(addsuffix .cma, $(ocaml-libs)) +ocamlopt-libs = $(addsuffix .cmxa, $(ocaml-libs)) + +section + target-flags += -Wno-long-long -I. + .SCANNER: %.o.scan: %.c + $(ocamlc) -ccopt $(quote $(c-cflags) \ + -MT $* -M -MG $(target-flags)) $< + + %.o: %.c :scanner: %.o.scan \ + :value: $(c-digest-deps) :value: $(c-emit-stdmake-rule $@) + $(ocamlc) -ccopt $(quote -c $(target-flags) $(c-cflags)) $< + + ml_apc.o: + +apc.byte: apc.cmo ml_apc.o + $(ocamlc) -custom $(ocamlc-lflags) $(ocamlc-libs) $(target-flags) -o $@ \ + ml_apc.o apc.cmo + +apc.opt: apc.cmx apc.o ml_apc.o + $(ocamlopt) $(ocamlopt-lflags) $(ocamlopt-libs) $(target-flags) -o $@ \ + apc.cmx ml_apc.o + +.PHONY: byte opt dist + +byte: apc.byte +opt: apc.opt + +all: byte + +apc-$(version).tgz: $(shell cat FILES) + mkdir -p apc-$(version) + tar -T $(file FILES) -cf - -C $(dirof FILES) | tar xf - -C apc-$(version) + tar cfz $@ apc-$(version) + +dist: apc-$(version).tgz + +add-env2 (mod) +.SUBDIRS: mod diff --git a/README b/README new file mode 100644 index 0000000..99c4530 --- /dev/null +++ b/README @@ -0,0 +1,80 @@ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This is APC - graphical CPU load meter. + +It is more suitable/accurate in situations where applications generate +"short" bursts of activity and the frequency of said bursts divides +kernel HZ value evenly. + +Kernel can use variety of values for HZ (most frequent: 100 250 1000) + +PAL/SECAM video frame grabbers do so with 25/50 FPS frequency, if the +pulse leads to some application deciding to burn CPU (putting the +frame on the screen, encoding it, etc) chances are good that the load +you will see in top(1) (or anything `/proc/stat' based) would not +represent reality accurately. Ditto for plain video clips. + +If you depend on sorta-kinda semi-correct load meter in those +conditions APC might present a better choice. + +The kernel module part of APC measures how much time is spent +executing idle kernel function - this information is represented by +yellow color, values obtained via `/proc/stat' are represented by red. + +You can use `-help' command line option to get a brief overview of +tunable parameters. + +Tested on: + +Linux 2.4.30 - AMD Athlon(tm) Processor (1.4 Ghz) +Linux 2.6.17.6 - AMD Athlon(tm)64 X2 Dual Core Processor 3800+ +Linux 2.6.28 - AMD Athlon(tm)64 3800+ + +It's possible that RMClock[1] does something similar(load measuring +wise) on Microsoft Windows. + +[1] http://cpu.rightmark.org/products/rmclock.shtml + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To build you will need: + +OCaml - http://caml.inria.fr/ocaml/ +LablGL - http://wwwfun.kurims.kyoto-u.ac.jp/soft/lsl/lablgl.html + (and by extension some OpenGL implementation) +GCC - http://gcc.gnu.org/ + +Plus all what is required to build a kernel module. + +Process: + + +$ sh build.sh +$ cd mod +$ su -c 'insmod ./its.ko' - 2.6 Kernels +$ su -c 'insmod ./its.o' - 2.4 Kernels + +If the module fails to load consult dmesg(8). Most likely cause is the +lack of exported `default_idle' function and no specific power +management idle function is specified. Few workarounds follow: + +Variant 1 + Add `idle=halt' to the kernel command line (method depends on the + boot-loader) and reboot. + +Variant 2 + ------------------------------------------------------------------ + Kernel 2..6 + $ func=$(awk '/default_idle$/ {print "0x" $1}' /proc/kallsyms) + $ su -c "insmod ./itc.ko idle_func=$func" + + ------------------------------------------------------------------ + Kernel 2.4 + $ func=$(awk '/default_idle$/ {print "0x" $1}' /proc/ksyms) + $ su -c "insmod ./itc.o idle_func=$func" + +====================================================================== +$ cd .. +$ major=$(awk '/ itc$/ {print $1}' /proc/devices) +$ su -c "mknod -m 0444 itc c $major 0" + +[make sure you are in X] +$ ./apc diff --git a/Thanks b/Thanks new file mode 100644 index 0000000..c8b6510 --- /dev/null +++ b/Thanks @@ -0,0 +1,5 @@ +Whole OCaml team + +Jacques Garrigue, Isaac Trotts, Erick Tryzelaar and Christophe Raffali + +German Zhivotnikov, Alexey Sterjantov diff --git a/apc.ml b/apc.ml new file mode 100644 index 0000000..9679771 --- /dev/null +++ b/apc.ml @@ -0,0 +1,775 @@ +open Format + +let (|>) x f = f x +let (|<) f x = f x + +let font = Glut.BITMAP_HELVETICA_12 +let draw_string ?(font=font) x y s = + GlPix.raster_pos ~x ~y (); + String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s + +module NP = struct + type sysinfo = + { uptime: int64 + ; loads: int64 * int64 * int64 + ; totalram: int64 + ; freeram: int64 + ; sharedram: int64 + ; bufferram: int64 + ; totalswap: int64 + ; freeswap: int64 + ; procs: int64 + } + + external get_nprocs : unit -> int = "ml_get_nprocs" + external idletimeofday : Unix.file_descr -> int -> float array + = "ml_idletimeofday" + external sysinfo : unit -> sysinfo = "ml_sysinfo" + external waitalrm : unit -> unit = "ml_waitalrm" + external get_hz : unit -> int = "ml_get_hz" + external setnice : int -> unit = "ml_nice" + + let user = 0 + let nice = 1 + let sys = 2 + let idle = 3 + let iowait = 4 + let intr = 5 + let softirq = 6 + + let hz = get_hz () |> float + + let jiffies_to_sec j = + float j /. hz + + let nprocs = get_nprocs () + + let rec parse_int_cont s pos = + let slen = String.length s in + let pos = + let rec skipws pos = + if pos = slen + then pos + else + if String.get s pos = ' ' + then succ pos |> skipws + else pos + in skipws pos + in + let endpos = + try String.index_from s pos ' ' + with Not_found -> slen + in + let i = endpos - pos |> String.sub s pos |> int_of_string in + if endpos = slen + then + `last i + else + `more (i, fun () -> succ endpos |> parse_int_cont s) + + let parse_cpul s = + let rec tolist accu = function + | `last i -> i :: accu + | `more (i, f) -> f () |> tolist (i :: accu) + in + let index = String.index s ' ' in + let cpuname = String.sub s 0 index in + let vals = parse_int_cont s (succ index) |> tolist [] in + let vals = List.rev |< + if List.length vals < 7 + then + 0 :: 0 :: 0 :: 0 :: vals + else + vals + in + cpuname, Array.of_list vals + + let parse_stat () = + fun () -> + let ic = open_in "/proc/stat" in + let rec loop i accu = + if i = -1 + then List.rev accu + else (input_line ic |> parse_cpul) :: accu |> loop (pred i) + in + let ret = loop nprocs [] in + close_in ic; + ret + + let getselfdir () = + try + Filename.dirname |< Unix.readlink "/proc/self/exe" + with exn -> + "./" +end + +let niceth nprocs = + for i = 0 to pred nprocs + do + Thread.create + (fun () -> + NP.setnice 20; + let rec loop i = succ i |> loop in loop 0 + ) + () |> ignore + done + +module Args = struct + let banner = + [ "Amazing Piece of Code by insanely gifted programmer, Version 0.90" + ; "Motivation by: gzh and afs" + ; "usage: " + ] |> String.concat "\n" + + let freq = ref 1.0 + let interval = ref 15.0 + let devpath = NP.getselfdir () |> Filename.concat |< "itc" |> ref + let pgrid = ref 10 + let sgrid = ref 10 + let w = ref 400 + let h = ref 200 + let verbose = ref false + let delay = ref 0.04 + let ksampler = ref true + let barw = ref 100 + let bars = ref 100 + let sigway = ref true + let niceval = ref 0 + let gzh = ref false + + let dA tos s {contents=v} = s ^ " (" ^ tos v ^ ")" + let dF = dA string_of_float + let dB = dA string_of_bool + let dI = dA string_of_int + let dS = dA (fun s -> "`" ^ String.escaped s ^ "'") + + let pad n s = + let l = String.length s in + if l >= n + then + s + else + let d = String.make n ' ' in + StringLabels.blit ~src:s ~dst:d + ~src_pos:0 ~len:l + ~dst_pos:0; + d + + let sF opt r doc = + "-" ^ opt, Arg.Set_float r, pad 9 " " ^ doc |> dF |< r + + let sI opt r doc = + "-" ^ opt, Arg.Set_int r, pad 9 " " ^ doc |> dI |< r + + let sB opt r doc = + "-" ^ opt, Arg.Set r, pad 9 "" ^ doc |> dB |< r + + let sBc opt r doc = + "-" ^ opt, Arg.Clear r, pad 9 "" ^ doc |> dB |< r + + let sS opt r doc = + "-" ^ opt, Arg.Set_string r, pad 9 " " ^ doc |> dS |< r + + let init () = + Arg.parse + [ sF "f" freq "update frequency" + ; sF "D" delay "refresh delay" + ; sF "i" interval "interval" + ; sI "p" pgrid "pgrid" + ; sI "s" sgrid "sgrid" + ; sI "w" w "width" + ; sI "h" h "height" + ; sI "b" barw "bar width" + ; sI "B" bars "number of CPU bars" + ; sI "n" niceval "value to renice self on init" + ; sS "d" devpath "path to itc device" + ; sBc "k" ksampler "do not show kernel view" + ; sB "v" verbose "verbose" + ; sB "S" sigway "sigwait delay method" + ] + (fun s -> + "don't know what to do with " ^ s |> prerr_endline; + exit 100 + ) + banner +end + +let oohz oohz fn = + let prev = ref 0.0 in + fun () -> + let a = !prev in + let b = Unix.gettimeofday () in + if b -. a > oohz + then + begin + prev := b; + fn () + end + +module Delay = struct + let sighandler signr = () + + let init () = + let () = + Sys.Signal_handle sighandler |> Sys.set_signal Sys.sigalrm; + if !Args.sigway + then + Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigalrm] |> ignore + ; + in + let v = 1e-6 /. !Args.freq in + let t = { Unix.it_interval = v; it_value = v } in + let _ = Unix.setitimer Unix.ITIMER_REAL t in + () + + let delay () = + if !Args.sigway + then NP.waitalrm () + else + try let _ = Unix.select [] [] [] ~-.1.0 in () + with Unix.Unix_error (Unix.EINTR, _, _) -> () +end + +module Sampler(T : sig val nsamples : int val freq : float end) = +struct + let nsamples = T.nsamples + let samples = Array.create nsamples 0.0 + let head = ref 0 + let active = ref 0 + + let update v n = + let n = min nsamples n in + let rec loop i j = + if j = 0 + then () + else + let i = if i = nsamples then 0 else i in + Array.set samples i v; + loop (succ i) (pred j) + in + let () = loop !head n in + let () = head := (!head + n) mod nsamples in + let () = active := min (!active + n) nsamples in + () + + let getyielder () = + let tail = + let d = !head - !active in + if d < 0 + then nsamples + d + else d + in + let ry = ref (fun () -> assert false) in + let rec yield i () = + if i >= !active + then None + else + begin + ry := succ i |> yield; + Some ((i + tail) mod nsamples |> Array.get samples) + end + in + ry := yield 0; + (fun () -> !ry ()) + + let update t1 t2 i1 i2 = + let d = t2 -. t1 in + let i = i2 -. i1 in + let isamples = truncate (d /. T.freq) in + let l = 1.0 -. (i /. d) in + update l isamples; +end + +module type ViewSampler = +sig + val getyielder : unit -> unit -> float option + val update : float -> float -> float -> float -> unit +end + +type sampler = + { color : Gl.rgb; + getyielder : unit -> unit -> float option; + update : float -> float -> float -> float -> unit; + } + +module type View = +sig + val x : int + val y : int + val w : int + val h : int + val sgrid : int + val pgrid : int + val freq : float + val interval : float + val samplers : sampler list +end + +module View(V: sig val w : int val h : int end) = struct + let ww = ref 0 + let wh = ref 0 + let funcs = ref [] + + let keyboard ~key ~x ~y = + if key = 27 || key = Char.code 'q' + then exit 0 + + let add f = + funcs := f :: !funcs + + let display () = + GlClear.clear [`color]; + List.iter (fun (display, _) -> display ()) !funcs; + Glut.swapBuffers () + + let reshape ~w ~h = + ww := w; + wh := h; + List.iter (fun (_, reshape) -> reshape w h) !funcs; + GlClear.clear [`color]; + GlMat.mode `modelview; + GlMat.load_identity (); + GlMat.mode `projection; + GlMat.load_identity (); + GlMat.rotate ~y:1.0 ~angle:180.0 (); + GlMat.translate ~x:~-.1.0 ~y:~-.1.0 (); + GlMat.scale ~x:2.0 ~y:2.0 (); + Glut.postRedisplay () + + let init () = + let () = + Glut.initDisplayMode ~double_buffer:true (); + Glut.initWindowSize V.w V.h + in + let _ = Glut.createWindow "APC" in + Glut.displayFunc display; + Glut.reshapeFunc reshape; + Glut.keyboardFunc keyboard; + GlDraw.color (1.0, 1.0, 0.0) + + let update = + Glut.postRedisplay + + let func = Glut.idleFunc + + let run = Glut.mainLoop +end + +module Bar(T: sig val barw : int val bars : int end) = struct + let nbars = T.bars + let kload = ref 0.0 + let iload = ref 0.0 + let vw = ref 0 + let vh = ref 0 + let sw = float T.barw /. float !Args.w + let bw = ref 0 + let m = 1 + let fw = 3 * Glut.bitmapWidth font (Char.code 'W') + + let reshape w h = + vw := w; + vh := h; + bw := (float w *. sw |> truncate) - m; + ;; + + let display () = + let kload = min !kload 1.0 |> max 0.0 in + let iload = min !iload 1.0 |> max 0.0 in + let () = + GlDraw.viewport m 0 !bw 15; + GlDraw.color (1.0, 1.0, 1.0); + let kload = 100.0 *. kload in + let iload = 100.0 *. iload in + + GlMat.push (); + GlMat.load_identity (); + GlMat.scale ~x:(1.0/.float !bw) ~y:(1.0/.30.0) (); + + let ix = !bw / 2 - fw |> float in + let kx = - (fw + !bw / 2) |> float in + sprintf "%5.2f" iload |> draw_string ix 0.0; + sprintf "%5.2f" kload |> draw_string kx 0.0; + GlMat.pop (); + in + + let y = 18 in + let h = !vh - 15 - y in + let () = GlDraw.viewport m y !bw h in + + let () = + GlMat.push (); + GlMat.load_identity (); + GlMat.rotate ~y:1.0 ~angle:180.0 (); + GlMat.translate ~x:~-.1.0 ~y:~-.1.0 (); + GlMat.scale ~x:2.0 ~y:(2.0 /. float h) () + in + + let barm = 1 in + let mspace = barm * nbars in + let barh = (h + 66 - mspace / 2) / nbars |> float in + let barm = float barm in + let yb = 0.0 in + + let drawbar xl xr load = + let drawquads start lim yb : float = + let rec loop i yb = + if i = lim + then yb + else + let yt = yb +. barh in + let yn = yt +. barm in + GlDraw.vertex2 (xl, yb); + GlDraw.vertex2 (xl, yt); + GlDraw.vertex2 (xr, yt); + GlDraw.vertex2 (xr, yb); + succ i |> loop |< yn + in + GlDraw.begins `quads; + let yt = loop start yb in + GlDraw.ends (); + yt + in + let lim = load *. float nbars |> truncate in + let yb = drawquads 0 lim yb in + GlDraw.color (0.5, 0.5, 0.5); + ignore (drawquads lim nbars yb) + in + let xl = 0.01 in + let xr = 0.49 in + GlDraw.color (1.0, 1.0, 0.0); + drawbar xl xr iload; + let xl = 0.51 in + let xr = 0.99 in + GlDraw.color (1.0, 0.0, 0.0); + drawbar xl xr kload; + GlDraw.color (1.0, 1.0, 1.0); + GlMat.pop (); + ;; + + let update kload' iload' = + kload := kload' /. float NP.nprocs; + iload := iload' /. float NP.nprocs; + ;; +end + +module Graph (V: View) = struct + let sw = float V.w /. float !Args.w + let sh = float V.h /. float !Args.h + let sx = float V.x /. float V.w + let sy = float V.y /. float V.h + let vw = ref 0 + let vh = ref 0 + let vx = ref 0 + let vy = ref 0 + let fw = 3 * Glut.bitmapWidth font (Char.code '%') + let fh = 6 + let scale = V.freq /. V.interval + let gridlist = + let base = GlList.gen_lists ~len:1 in + GlList.nth base ~pos:0 + + let viewport typ = + let x, y, w, h = + match typ with + | `labels -> (!vx, !vy + 5, fw, !vh - 20) + | `graph -> (!vx + fw + 5, !vy + 5, !vw - fw - 10, !vh - 20) + in + GlDraw.viewport x y w h + + let grid () = + let scale = 1.0 /. float V.sgrid in + viewport `graph; + GlDraw.line_width 1.0; + GlDraw.color (0.0, 1.0, 0.0); + GlDraw.begins `lines; + for i = 0 to V.sgrid + do + let x = float i *. scale in + let x = if i = 0 then 0.0009 else x in + GlDraw.vertex ~x ~y:0.0 (); + GlDraw.vertex ~x ~y:1.0 (); + done; + let lim = 100 / V.pgrid in + let () = + for i = 0 to lim + do + let y = (i * V.pgrid |> float) /. 100.0 in + let y = if i = lim then y -. 0.0009 else y in + GlDraw.vertex ~x:0.0 ~y (); + GlDraw.vertex ~x:1.0 ~y (); + done + in + let () = + GlDraw.ends (); + viewport `labels; + GlDraw.color (1.0, 1.0, 1.0); + in + let ohp = 100.0 in + for i = 0 to 100 / V.pgrid + do + let p = i * V.pgrid in + let y = float p /. ohp in + let s = Printf.sprintf "%3d%%" p in + draw_string 1.0 y s + done + ;; + + let reshape w h = + let wxsw = float w *. sw + and hxsh = float h *. sh in + vw := wxsw |> truncate; + vh := hxsh |> truncate; + vx := wxsw *. sx |> truncate; + vy := hxsh *. sy |> truncate; + GlList.begins gridlist `compile; + grid (); + GlList.ends (); + ;; + + let swap = + Glut.swapBuffers |> oohz !Args.delay; + ;; + + let display () = + (* grid (); *) + GlList.call gridlist; + GlDraw.line_width 1.5; + viewport `graph; + + let sample sampler = + GlDraw.color sampler.color; + GlDraw.begins `line_strip; + let yield = sampler.getyielder () in + let rec loop last i = + match yield () with + | Some y as opty -> + let x = float i *. scale in + GlDraw.vertex ~x ~y (); + loop opty (succ i) + | None -> last, succ i + in + let () = + match loop None 0 with + | None, _ -> () + | Some y, i -> + let x = float i *. scale in + GlDraw.vertex ~x ~y () + in + GlDraw.ends (); + in + List.iter sample V.samplers + + let funcs = display, reshape +end + +let getplacements w h n barw = + let sr = float n |> sqrt |> ceil |> truncate in + let d = n / sr in + let r = if n mod sr = 0 then 0 else 1 in + let x, y = + if w - barw > h + then + sr + r, d + else + d, sr + r + in + let w' = w - barw in + let h' = h in + let vw = w' / x in + let vh = h' / y in + let rec loop accu i = + if i = n + then accu + else + let yc = i / x in + let xc = i mod x in + let xc = xc * vw + barw in + let yc = yc * vh in + (i, xc, yc) :: accu |> loop |< succ i + in + loop [] 0, vw, vh + +let create fd w h = + let module S = + struct + let freq = !Args.freq + let nsamples = !Args.interval /. freq |> ceil |> truncate + end + in + let placements, vw, vh = getplacements w h NP.nprocs !Args.barw in + + let iget () = NP.idletimeofday fd NP.nprocs in + let is = iget () in + + let kget () = + let gks = NP.parse_stat () in + gks () |> Array.of_list + in + let ks = kget () in + + let crgraph (kaccu, iaccu) (i, x, y) = + let module Si = Sampler (S) in + let isampler = + { getyielder = Si.getyielder + ; color = (1.0, 1.0, 0.0) + ; update = Si.update + } + in + let (kcalc, ksampler) = + let module Sc = Sampler (S) in + let sampler = + { getyielder = Sc.getyielder + ; color = (1.0, 0.0, 0.0) + ; update = Sc.update + } + in + let calc = + let i' = if i = NP.nprocs then 0 else succ i in + if !Args.gzh + then + let g ks = + let ks = Array.get ks i' |> snd in + let user = Array.get ks NP.user in + let nice = Array.get ks NP.nice in + let _idle = Array.get ks NP.idle in + NP.jiffies_to_sec (nice - user) + in + let i1 = g ks |> ref in + fun ks t1 t2 -> + let i2 = g ks in + let i1' = !i1 + and i2' = i2 in + i1 := i2; + 0.0, 1.0 -. (i2' -. i1') + else + let n = NP.idle in + let g ks = Array.get ks i' |> snd |> Array.get |< n in + let i1 = g ks |> ref in + fun ks t1 t2 -> + let i2 = g ks in + let i1' = NP.jiffies_to_sec !i1 + and i2' = NP.jiffies_to_sec i2 in + i1 := i2; + i1', i2' + in + calc, sampler + in + let module V = + struct + let x = x + let y = y + let w = vw + let h = vh + let freq = S.freq + let interval = !Args.interval + let pgrid = !Args.pgrid + let sgrid = !Args.sgrid + let samplers = + if !Args.ksampler + then [isampler; ksampler] + else [isampler] + end + in + let module Graph = Graph (V) in + let icalc = + let i1 = Array.get is i |> ref in + fun is t1 t2 -> + let i2 = Array.get is i in + let result = + if i2 = 0.0 + then + let () = i1 := !i1 +. (t2 -. t1) in + t1, t2 + else + let i1' = !i1 in + i1 := i2; + i1', i2 + in + result + in + let kaccu = + if !Args.ksampler + then (i, kcalc, ksampler, Graph.funcs) :: kaccu + else kaccu + in + kaccu, (i, icalc, isampler, Graph.funcs) :: iaccu + in + let kl, il = List.fold_left crgraph ([], []) placements in + ((if kl == [] then (fun () -> [||]) else kget), kl), (iget, il) + +let opendev path = + try + Unix.openfile path [Unix.O_RDONLY] 0 + with + | Unix.Unix_error (Unix.ENODEV, s1, s2) -> + eprintf "Could not open ITC device %S:\n%s(%s): %s)\n" + path s1 s2 |< Unix.error_message Unix.ENODEV; + eprintf "(perhaps the module is not loaded?)@."; + exit 100 + + | Unix.Unix_error (Unix.ENOENT, s1, s2) -> + eprintf "Could not open ITC device %S:\n%s(%s): %s\n" + path s1 s2 |< Unix.error_message Unix.ENOENT; + exit 100 + +let main () = + let _ = Glut.init [|""|] in + let () = Args.init () in + let () = Delay.init () in + let () = if !Args.niceval != 0 then NP.setnice !Args.niceval in + let () = if !Args.gzh then niceth NP.nprocs in + let w = !Args.w + and h = !Args.h in + let fd = opendev !Args.devpath in + let module FullV = View (struct let w = w let h = h end) in + let () = FullV.init () in + let (kget, kfuncs), (iget, ifuncs) = create fd w h in + let module Bar = + Bar (struct let barw = !Args.barw let bars = !Args.bars end) + in + let () = + FullV.add (Bar.display, Bar.reshape); + List.iter (fun (_, _, _, gfuncs) -> FullV.add gfuncs) kfuncs; + List.iter (fun (_, _, _, gfuncs) -> FullV.add gfuncs) ifuncs; + in + let rec loop t1 () = + let t2 = Unix.gettimeofday () in + let d = t2 -. t1 in + if d >= !Args.freq + then + let is = iget () in + let ks = kget () in + let rec loop2 load s = function + | [] -> load + | (nr, calc, sampler, _) :: rest -> + let i1, i2 = calc s t1 t2 in + let () = + if !Args.verbose + then + ("cpu load(" ^ string_of_int nr ^ "): " + ^ (100.0 -. ((i2 -. i1) /. d) *. 100.0 |> string_of_float) + |> prerr_endline) + in + let load = load +. (1.0 -. ((i2 -. i1) /. d)) in + sampler.update t1 t2 i1 i2; + loop2 load s rest + in + let iload = loop2 0.0 is ifuncs in + let kload = loop2 0.0 ks kfuncs in + Bar.update kload iload; + FullV.update (); + FullV.func (Some (loop t2)) + else + Delay.delay () + in + FullV.func (Some (Unix.gettimeofday () |> loop)); + FullV.run () + +let _ = + try main () + with + | Unix.Unix_error (e, s1, s2) -> + eprintf "%s(%s): %s@." s1 s2 |< Unix.error_message e + + | exn -> + Printexc.to_string exn |> eprintf "Exception: %s@." diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..528abcf --- /dev/null +++ b/build.sh @@ -0,0 +1,10 @@ +#!/bin/sh + +set -e + +libs="unix.cma lablgl.cma lablglut.cma threads.cma" +flags="-custom -thread -I +lablGL" +test -z "$comp" && comp=ocamlc +$comp -o apc $flags $libs apc.ml ml_apc.c + +(cd mod && make) diff --git a/ml_apc.c b/ml_apc.c new file mode 100644 index 0000000..276b536 --- /dev/null +++ b/ml_apc.c @@ -0,0 +1,139 @@ +#define _XOPEN_SOURCE 700 +#define _GNU_SOURCE +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +static void failwith_fmt (const char *fmt, ...) Noreturn; +static void failwith_fmt (const char *fmt, ...) +{ + va_list ap; + char buf[1024]; + + va_start (ap, fmt); + vsnprintf (buf, sizeof (buf), fmt, ap); + va_end (ap); + + failwith (buf); +} + + +CAMLprim value ml_waitalrm (value unit_v) +{ + CAMLparam1 (unit_v); + sigset_t set; + int signr; + + sigemptyset (&set); + sigaddset (&set, SIGALRM); + if (sigwait (&set, &signr)) { + failwith_fmt ("sigwait: %s", strerror (errno)); + } + CAMLreturn (Val_unit); +} + +CAMLprim value ml_sysinfo (value unit_v) +{ + CAMLparam1 (unit_v); + CAMLlocal2 (res_v, loads_v); + struct sysinfo si; + + if (sysinfo (&si)) { + failwith_fmt ("sysinfo: %s", strerror (errno)); + } + + loads_v = caml_alloc_tuple (3); + Store_field (loads_v, 0, caml_copy_int64 (si.loads[0])); + Store_field (loads_v, 1, caml_copy_int64 (si.loads[1])); + Store_field (loads_v, 2, caml_copy_int64 (si.loads[2])); + + res_v = caml_alloc_tuple (9); + Store_field (res_v, 0, caml_copy_int64 (si.uptime)); + Store_field (res_v, 1, loads_v); + Store_field (res_v, 2, caml_copy_int64 (si.totalram)); + Store_field (res_v, 3, caml_copy_int64 (si.freeram)); + Store_field (res_v, 4, caml_copy_int64 (si.sharedram)); + Store_field (res_v, 5, caml_copy_int64 (si.bufferram)); + Store_field (res_v, 6, caml_copy_int64 (si.totalswap)); + Store_field (res_v, 7, caml_copy_int64 (si.freeswap)); + Store_field (res_v, 8, caml_copy_int64 (si.procs)); + + CAMLreturn (res_v); +} + +CAMLprim value ml_get_nprocs (value unit_v) +{ + CAMLparam1 (unit_v); + int nprocs; + + nprocs = get_nprocs (); + if (nprocs <= 0) { + failwith_fmt ("get_nprocs: %s", strerror (errno)); + } + + CAMLreturn (Val_int (nprocs)); +} + +CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v) +{ + CAMLparam2 (fd_v, nprocs_v); + CAMLlocal1 (res_v); + struct timeval tv; + int fd = Int_val (fd_v); + int nprocs = Int_val (nprocs_v); + size_t n = nprocs * sizeof (tv); + ssize_t m; + struct timeval *buf; + int i; + + buf = alloca (n); + if (!buf) { + failwith_fmt ("alloca: %s", strerror (errno)); + } + + m = read (fd, buf, n); + if (n - m) { + failwith_fmt ("read [n=%zu, m=%zi]: %s", n, m, strerror (errno)); + } + + res_v = caml_alloc (nprocs * Double_wosize, Double_array_tag); + for (i = 0; i < nprocs; ++i) { + double d = buf[i].tv_sec + buf[i].tv_usec * 1e-6; + + Store_double_field (res_v, i, d); + } + CAMLreturn (res_v); +} + +CAMLprim value ml_get_hz (value unit_v) +{ + CAMLparam1 (unit_v); + CAMLreturn (Val_int (sysconf (_SC_CLK_TCK))); +} + +CAMLprim value ml_nice (value nice_v) +{ + CAMLparam1 (nice_v); + int niceval = Int_val (nice_v); + + if (!nice (niceval)) { + failwith_fmt ("nice %d: %s", niceval, strerror (errno)); + } + + CAMLreturn (Val_unit); +} diff --git a/mod/Makefile b/mod/Makefile new file mode 100644 index 0000000..55ec7db --- /dev/null +++ b/mod/Makefile @@ -0,0 +1,48 @@ +.PHONY: itc-all itc-build-module itc-install-module + +itc-all:: itc-build-module + +KVERSION ?= $(shell uname -r) +KDIR ?= /lib/modules/$(KVERSION)/build +OUTDIR ?= /lib/modules/$(KVERSION)/misc + +MM := $(shell echo $(KVERSION) | cut -d. -f'1 2') + +ifeq ($(MM),2.4) +KMOD_SUFFIX := .o +K24 := defined +else +ifeq ($(MM),2.6) +KMOD_SUFFIX := .ko +else +$(error Only 2.4 and 2.6 kernel series are supported. You have "$(KVERSION)") +endif +endif + +itc-objs := itc-mod.o + +ifdef TOPDIR +obj-m := itc.o +endif + +ifdef K24 +itc.o: $(itc-objs) + $(LD) $(EXTRA_LDFLAGS) -o $@ -r $(itc-objs) + +include $(KDIR)/Rules.make +endif + +$(KDIR)/Makefile: + @echo Cannot build module, kernel sources are probably not installed + @exit 1 + +$(KDIR)/.config: + @echo Cannot build module, kernel is not configured + @exit 1 + +itc-build-module:: $(KDIR)/Makefile $(KDIR)/.config + $(MAKE) -C $(KDIR) modules SUBDIRS=$(CURDIR) M=$(CURDIR) + +itc-install-module:: itc-build-module + mkdir -p $(OUTDIR) + install -m 0400 -o 0 -g 0 itc$(KMOD_SUFFIX) $(OUTDIR) diff --git a/mod/OMakefile b/mod/OMakefile new file mode 100644 index 0000000..58690b7 --- /dev/null +++ b/mod/OMakefile @@ -0,0 +1,9 @@ +.PHONY: mod + +release = $(shell uname -r) + +mkdir -p $(release) +vmount (-l, $(dirof OMakefile), $(release)) +.SUBDIRS: $(release) + mod: Makefile its-mod.c + make diff --git a/mod/itc-mod.c b/mod/itc-mod.c new file mode 100644 index 0000000..1e887f7 --- /dev/null +++ b/mod/itc-mod.c @@ -0,0 +1,286 @@ +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#if LINUX_VERSION_CODE < KERNEL_VERSION (2, 6, 0) + #include + #ifdef CONFIG_SMP + #define NB_CPUS weight (phys_cpu_present_map) + #else + #define NB_CPUS 1 + #endif + + #if LINUX_VERSION_CODE < KERNEL_VERSION (2, 4, 20) + #define iminor(inode) MINOR((inode)->i_rdev) + #else + #define iminor(inode) minor((inode)->i_rdev) + #endif +#else + #define NB_CPUS num_present_cpus () +#endif + + +MODULE_DESCRIPTION ("Idle time collector"); + +static void (*idle_func) (void); +#if LINUX_VERSION_CODE < KERNEL_VERSION (2, 6, 0) +MODULE_PARM (idle_func, "l"); +#else +module_param (idle_func, long, 0777); +#endif +MODULE_PARM_DESC (idle_func, "address of default idle function"); + +#define DEVNAME "itc" +static spinlock_t lock = SPIN_LOCK_UNLOCKED; + +static void (*orig_pm_idle) (void); +static unsigned int itc_major; +static struct timeval total_idle_tv[NR_CPUS]; + +/********************************************************************** + * + * File operations + * + **********************************************************************/ +static int +itc_open (struct inode * inode, struct file * file); + +static int +itc_release (struct inode * inode, struct file * file); + +static int +itc_ioctl (struct inode * inode, struct file * file, + unsigned int cmd, unsigned long arg); + +static ssize_t +itc_read (struct file * file, char * buf, size_t count, loff_t * ppos); + +static struct file_operations itc_fops = + { + .owner = THIS_MODULE, + .open = itc_open, + .release = itc_release, + .ioctl = itc_ioctl, + .llseek = no_llseek, + .read = itc_read, + }; + + +static int +itc_release (struct inode * inode, struct file * filp) +{ + return 0; +} + +static int +itc_open (struct inode * inode, struct file * filp) +{ + int ret = 0; + const struct file_operations *old_fops = filp->f_op; + unsigned int minor = iminor (inode); + + if (minor != 0) + return -ENODEV; + + /* old_fops = filp->f_op; */ + filp->f_op = fops_get (&itc_fops); + fops_put (old_fops); + return ret; +} + +static ssize_t +itc_read (struct file *file, char * buf, size_t count, loff_t * ppos) +{ + int i; + size_t itemsize = sizeof (total_idle_tv[0]); + ssize_t retval = 0; + unsigned long flags; + + /* printk ("itemsize=%d cpus=%d count=%d\n", itemsize, NR_CPUS, count); */ + if (count < itemsize * NB_CPUS) + { + printk (KERN_ERR "attempt to read something funny %d expected %d(%d,%d)\n", + count, itemsize * NB_CPUS, itemsize, NB_CPUS); + return -EINVAL; + } + + spin_lock_irqsave (&lock, flags); + for (i = 0; i < NB_CPUS; ++i) + { + if (copy_to_user (buf, &total_idle_tv[i], itemsize)) + { + printk (KERN_ERR "failed to write %zu bytes to %p\n", itemsize, buf); + spin_unlock_irqrestore (&lock, flags); + return -EFAULT; + } + retval += itemsize; + buf += itemsize; + } + + spin_unlock_irqrestore (&lock, flags); + return retval; +} + +/********************************************************************** + * + * ioctl handler + * + **********************************************************************/ +static int +itc_ioctl (struct inode * inode, struct file * filp, + unsigned int cmd, unsigned long arg) +{ + return 0; +} + +/********************************************************************** + * + * idle + * + **********************************************************************/ +#if LINUX_VERSION_CODE > KERNEL_VERSION (2, 6, 0) +#ifndef CONFIG_APM +#define QUIRK +#endif +#else +void default_idle (void); +#endif + +static void +itc_idle (void) +{ + struct timeval tv1, tv2, tv3, *t; + suseconds_t usec; + unsigned long flags; + + spin_lock_irqsave (&lock, flags); + t = &total_idle_tv[smp_processor_id ()]; + tv3.tv_sec = t->tv_sec; + tv3.tv_usec = t->tv_usec; + t->tv_sec = 0; + t->tv_usec = 0; + do_gettimeofday (&tv1); + spin_unlock_irqrestore (&lock, flags); + +#ifdef QUIRK + if (orig_pm_idle) + { + orig_pm_idle (); + } + else + { + idle_func (); + } +#else + if (orig_pm_idle) + { + orig_pm_idle (); + } + else + { + if (idle_func) + { + idle_func (); + } + else + { + default_idle (); + } + } +#endif + + spin_lock_irqsave (&lock, flags); + do_gettimeofday (&tv2); + usec = tv2.tv_usec - tv1.tv_usec + tv3.tv_usec; + tv3.tv_sec += (tv2.tv_sec - tv1.tv_sec); + while (usec > 1000000) + { + usec -= 1000000; + tv3.tv_sec += 1; + } + t->tv_usec = usec; + t->tv_sec = tv3.tv_sec; + spin_unlock_irqrestore (&lock, flags); +} + +/********************************************************************** + * + * Module constructor + * + **********************************************************************/ +static __init int +init (void) +{ + int err; + +#ifdef QUIRK + if (!pm_idle && !idle_func) + { + printk (KERN_ERR + "itc: no idle function\n" + "itc: boot kernel with idle=halt option\n" + "itc: or specify idle_func (modprobe its idle_func=
\n"); + return -ENODEV; + } +#endif + + err = register_chrdev (itc_major, DEVNAME, &itc_fops); + if (err < 0 || ((itc_major && err) || (!itc_major && !err))) + { + printk (KERN_ERR "itc: register_chrdev failed itc_major=%d err=%d\n", + itc_major, err); + return -ENODEV; + } + + if (!itc_major) + { + itc_major = err; + } + + printk + (KERN_DEBUG + "itc: driver successfully loaded pm_idle=%p default_idle=%p, idle_func=%p\n", + pm_idle, +#ifdef QUIRK + NULL, +#else + default_idle, +#endif + idle_func + ); + + orig_pm_idle = pm_idle; + pm_idle = itc_idle; + return 0; +} + +/********************************************************************** + * + * Module destructor + * + **********************************************************************/ +static __exit void +fini (void) +{ + printk (KERN_DEBUG "itc: unloading\n"); + + unregister_chrdev (itc_major, DEVNAME); + printk (KERN_DEBUG "itc: unloaded\n"); + + pm_idle = orig_pm_idle; +} + +module_init (init); +module_exit (fini); -- 2.11.4.GIT