From 88f12126ec701b8fdeb9ffd1c6d13526aa40ddb4 Mon Sep 17 00:00:00 2001 From: malc Date: Sun, 8 Jul 2007 17:38:51 +0400 Subject: [PATCH] v0.98 --- Changes | 11 +- FILES | 1 - OMakefile | 102 +++++------- OMakeroot | 498 ++++++++++++++++++---------------------------------------- README | 18 ++- Thanks | 2 + apc.ml | 245 +++++++++++++++++++++++------ hog.c | 3 +- mod/itc-mod.c | 58 +++++-- 9 files changed, 458 insertions(+), 480 deletions(-) rewrite OMakefile (86%) rewrite OMakeroot (89%) diff --git a/Changes b/Changes index 81696e7..8d20fac 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,12 @@ +8 + * Only allow one application to open and use the module at a time + + * "Fix" module_param + idle_func + + * Optional separate sys/nice/iowait/intr colors for kernel sampler + + * ITC_PREEMPT_HACK is now the default for preemptible kernels + 7 * Stop collecting information upon release Start upon open @@ -43,4 +52,4 @@ * Fixes here and there 1 - * Mark `idle_func' method of geting module to load as DANGEROUS + * Mark `idle_func' method of getting module to load as DANGEROUS diff --git a/FILES b/FILES index ef48d9e..fdb4222 100644 --- a/FILES +++ b/FILES @@ -2,7 +2,6 @@ apc.ml OMakefile OMakeroot mod/Makefile -mod/OMakefile mod/itc-mod.c ml_apc.c build.sh diff --git a/OMakefile b/OMakefile dissimilarity index 86% index 47a41c1..983c393 100644 --- a/OMakefile +++ b/OMakefile @@ -1,60 +1,42 @@ -version = 0.97c - -ocaml-includes = -I +lablGL - -ocamlc-cflags += -g $(ocaml-includes) -thread -ocamlopt-cflags += $(ocaml-includes) -thread -compact - -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)) - -if $(target-win32) - target-flags += -I. - %.obj: %.c :value: $(c-digest-deps) :value: $(c-emit-stdmake-rule $@) - $(ocamlc) -ccopt $(string -c $(target-flags) $(c-cflags)) $< - - ml_apc.obj: -else - target-flags += -Wno-long-long -I. - .SCANNER: %.o.scan: %.c - $(ocamlc) -ccopt $(string $(c-cflags) \ - -MT $* -M -MG $(target-flags)) $< - - %.o: %.c :scanner: %.o.scan \ - :value: $(c-digest-deps) :value: $(c-emit-stdmake-rule $@) - $(ocamlc) -ccopt $(string -c $(target-flags) $(c-cflags)) $< - - ml_apc.o: - -$(exename apc.byte): apc.cmo ml_apc$(obj) - $(ocamlc) -custom $(ocamlc-lflags) $(ocamlc-libs) $(target-flags) -o $@ \ - ml_apc$(obj) apc.cmo -# imt link -edit -subsystem\:windows $@ - -$(exename apc.opt): apc.cmx apc$(obj) ml_apc$(obj) - $(ocamlopt) $(ocamlopt-lflags) $(ocamlopt-libs) $(target-flags) -o $@ \ - apc.cmx ml_apc$(obj) -# imt link /edit /subsystem\:windows $@ - -.PHONY: byte opt dist - -byte: $(exename apc.byte) -opt: $(exename apc.opt) - -all: byte - -apc-$(version).tgz: $(shell cat FILES) - rm -fr apc-$(version) - mkdir -p apc-$(version) - tar -T $(file FILES) -chf - -C $(dirof FILES) | tar xf - -C apc-$(version) - tar cfz $@ apc-$(version) - -dist: apc-$(version).tgz - -if $(not $(target-win32)) - add-env2 (mod) - .SUBDIRS: mod +version = 0.98 + +.PHONY: all clean dist mod +.DEFAULT: all + +Mocamlc (apc, -warn-error A -g -thread -I +lablGL) +Mocamlcc (ml_apc, -Wall -Werror -g) +Mocamlopt (apc, -warn-error A -thread -I +lablGL) + +objs = ml_apc.o +libs = unix lablgl lablglut threads + +section + cmos = apc.cmo + libs = $(addsuffix .cma, $(libs)) + flags = -thread -custom -I +lablGL + apc.byte: $(cmos) $(objs) + ocamlc.opt $(flags) -o $@ $(libs) $(caml-sort $(cmos)) $(objs) + +section + cmxs = apc.cmx + libs = $(addsuffix .cmxa, $(libs)) + flags = -thread -I +lablGL + apc.opt: $(cmxs) $(objs) apc.o + ocamlopt.opt $(flags) -o $@ $(libs) $(caml-sort $(cmxs)) $(objs) + +mkdir -p mod +add-project-directories ($(dirof OMakefile)/mod) +vmount (-l, $(dirof OMakefile)/mod, mod) +.SUBDIRS: mod + mod: itc-mod.c Makefile + make + +all: apc.byte + +apc-$(version).tgz: $(shell cat FILES) + rm -fr apc-$(version) + mkdir -p apc-$(version) + tar -T $(file FILES) -chf - -C $(dirof FILES) | tar xf - -C apc-$(version) + tar cfz $@ apc-$(version) + +dist: apc-$(version).tgz diff --git a/OMakeroot b/OMakeroot dissimilarity index 89% index c6c9a4d..98de870 100644 --- a/OMakeroot +++ b/OMakeroot @@ -1,347 +1,151 @@ -OMakeFlags(-w) - -if $(not $(defined TARGET_OS)) - if $(equal $(OSTYPE), Win32) - TARGET_OS = win - export - else - TARGET_OS = nix - export - export -#TARGET_OS = win -#TARGET_OS = nix - -imt = imt #$(file build/common/bin/imt) -cc = gcc -cxx = g++ -ocamlc-cflags = -warn-error A -g -ocamlopt-cflags = -warn-error A -ocamlc-lflags = -ocamlopt-lflags = -target-flags = -ocamlc = ocamlc.opt -ocamlopt = ocamlopt.opt -ocamldep = ocamldep -host-win32 = $(equal $(OSTYPE), Win32) -target-win32 = $(equal $(TARGET_OS), win) -cross-win32 = $(and $(target-win32), $(not $(host-win32))) -target-mingw = $(defined mingw) -mingw = $(EMPTY) -darwin = $(equal $(SYSNAME), Darwin) - -if $(defined top-dir) - ls -lR $(top-dir) >/dev/null - -if $(target-win32) - if $(target-mingw) - mingw = $(if $(cross-win32), mingwf, $(EMPTY)) - wine = $(if $(cross-win32), wine, $(EMPTY)) -# if $(cross-win32) -# wineserver -p - exe = .exe - obj = .o - dllname(name) = - return $(name).dll - libname(name) = - return lib$(name).a - exename(name) = - return $(name).exe - ocamlc = $(wine) ocamlc.opt.exe - ocamlopt = $(wine) ocamlopt.opt.exe - if $(not $(cross-win32)) - ocamldep = ocamldep.exe - export - cc = $(mingw) gcc - cxx = $(mingw) g++ - c-cflags = -Wall -Werror -g - cxx-cflags = -Wall -Werror -g - TARGET_OS = mingw - export - else - dxsdk = $(getenv DXSDK_DIR, $(EMPTY)) - if $(not $(equal $(dxsdk), $(EMPTY))) - setenv (INCLUDE, $(getenv INCLUDE)$";$(dxsdk)\include") - setenv (LIB, $(getenv LIB)$";$(dxsdk)\lib\x86") - export - wine = $(if $(cross-win32), wine, $(EMPTY)) - if $(cross-win32) - wineserver -p - exe = .exe - obj = .obj - dllname(name) = - return $(name).dll - libname(name) = - return $(name).lib - exename(name) = - return $(name).exe - ocamlc = $(wine) ocamlc.opt.exe - ocamlopt = $(wine) ocamlopt.opt.exe - if $(not $(cross-win32)) - ocamldep = ocamldep.exe - export - c-cflags = -WX -W4 -Zi -MT - cxx-cflags = -WX -W4 -Zi -MT - export - export -else - obj = .o - exe = - switch $(SYSNAME) - case Darwin - dllname(name) = - return lib$(name).a - export dllname - default - dllname(name) = - return lib$(name).so - export dllname - libname(name) = - return lib$(name).a - exename(name) = - return $(name) - c-cflags = -Wall -Werror -W -fstrict-aliasing -g -Wno-long-long -pipe - cxx-cflags = -Wall -Werror -W -fstrict-aliasing -g -Wno-long-long -pipe - c-cflags += -pedantic - cxx-cflags = -pedantic - export - -match $(MACHINE) -case $"i[3456]86" - c-cflags += -DX86_ASSEMBLER - x86 = true - export -case $"Power.*" - c-cflags += -DWORDS_BIGENDIAN - x86 = false - export -case $"ppc" - c-cflags += -DWORDS_BIGENDIAN - x86 = false - export -default - eprintln (Machine "$(MACHINE)" is not recognized) - x86 = false -# exit (1) - -emit-stdmake-rule(name) = - if $(defined make-file) - t = $(target $(name)) - deps = $(fullname $(filter-targets $(filter-out %.scan, $(t.build-deps)))) - stdout = $(make-file) - echo $(fullname $(t.target))\: $(deps) - d = $(fullname $(dirof $(t.target))) - # mucho importante - first char after quotation mark is tab - echo " mkdir -p $d && cd $d && $(t.build-commands)" - return - -caml-emit-stdmake-rule(name) = - emit-stdmake-rule($(name)) - -c-emit-stdmake-rule(name) = - emit-stdmake-rule($(name)) - -cxx-emit-stdmake-rule(name) = - emit-stdmake-rule($(name)) - -emit-stdmake-line(line) = - if $(defined make-file) - fprintln($(make-file), $(line)) - -emit-stdmake-dep(target, prereq) = - emit-stdmake-line($(target)\: $(fullname $(prereq))) - -.ORDER: .caml-order -.caml-order: %.cmi: %.cmo -.caml-order: %.cmx: %.cmo - -caml-sort(files) = - return $(file-sort .caml-order, $(files)) - -collect-includes(flags) = - dirs[] = - next = false - foreach (f, $(flags)) - if $(next) - dirs += $f - next = false - export - else - f = $(string $f) - l = $(f.length) - if $(and $(gt $l, 1), \ - $(and $(equal $(f.nth 0), -), \ - $(equal $(f.nth 1), I))) - if $(gt $l, 2) - dirs += $(removeprefix -I, $f) - export - else - next = true - export - export - export - export - return $(dirs) - -cpp-digest-deps(flags) = - includes = $(collect-includes $(flags)) - return $(digest-in-path-optional $(includes) ., $&) - -c-digest-deps() = - return cpp-digest-deps($(c-cflags) $(target-flags)) - -cxx-digest-deps() = - return cpp-digest-deps($(cxx-cflags) $(target-flags)) - -Shell. += - pr-list(argv) = - foreach(a, $(argv)) - println($a) - - eecho(argv) = - eprintln($(string $(argv))) - - caml-scan(argv) = - emacs-helper = directory $"`"$(absname $(dirof $<))\' - depflags = $(mapprefix -I, \ - $(collect-includes $(target-flags) $(ocamlc-cflags))) - eecho make[0]\: Entering $(emacs-helper) - depflags += $(if $(equal $(length $(filter-out %.cmx, $@)), 0),-native,$(EMPTY)) - cd $(dirof $<) && \ - $(ocamldep) $(depflags) $(basename $<) && \ - eecho make[0]\: Leaving $(emacs-helper) #|| exit 10 - -.SCANNER: %.o.scan: %.c - $(cc) -MT $* -M $(target-flags) $(c-cflags) $< - -.SCANNER: %.o.scan: %.cpp - $(cxx) -MT $* -M $(target-flags) $(cxx-cflags) $< - -%.o: %.c :scanner: %.o.scan \ - :value: $(c-digest-deps) :value: $(c-emit-stdmake-rule $@) - $(cc) -c $(target-flags) $(c-cflags) $< - -%.o: %.cpp :scanner: %.o.scan \ - :value: $(cxx-digest-deps) :value: $(cxx-emit-stdmake-rule $@) - $(cxx) -c $(target-flags) $(cxx-cflags) $< - -.SCANNER: %.obj.scan: %.c - imt dep7 $* $(target-flags) $(c-cflags) $< - -.SCANNER: %.obj.scan: %.cpp - imt dep7 $* $(target-flags) $(cxx-cflags) $< - -%.obj: %.c :scanner: %.obj.scan \ - :value: $(c-digest-deps) :value: $(c-emit-stdmake-rule $@) - imt cl -c $(target-flags) $(c-cflags) $< - -%.obj: %.cpp :scanner: %.obj.scan \ - :value: $(cxx-digest-deps) :value: $(cxx-emit-stdmake-rule $@) - imt cl -c $(target-flags) $(cxx-cflags) $< - -.SCANNER: %.cmo.scan: %.ml - caml-scan - -.SCANNER: %.cmx.scan: %.ml - caml-scan - -.SCANNER: %.cmi.scan: %.mli - caml-scan - -%.cmi %.cmi-o: %.mli :scanner: %.cmi.scan - $(ocamlc) -o $*.cmi -c $(target-flags) $(ocamlc-cflags) $< && touch $*.cmi-o - -%.cmi %.cmi-x: %.mli :scanner: %.cmi.scan - $(ocamlopt) -o $*.cmi -c $(target-flags) $(ocamlopt-cflags) $< \ - && touch $*.cmi-x - -%.cmo: %.ml - section rule - if $(target-exists %.mli) - %.cmo: %.ml %.cmi-o %.cmi :value: $(caml-emit-stdmake-rule $@) \ - :scanner: %.cmo.scan - $(ocamlc) -o $@ -c $(target-flags) $(ocamlc-cflags) $< - else - %.cmo: %.ml :scanner: %.cmo.scan :effects: %.cmi \ - :value: $(caml-emit-stdmake-rule $@) - $(ocamlc) -o $@ -c $(target-flags) $(ocamlc-cflags) $< - -if $(target-win32) - %.obj %.cmx: %.ml - section rule - if $(target-exists %.mli) - %.obj %.cmx: %.ml %.cmi-x %.cmi \ - :value: $(caml-emit-stdmake-rule $@) - $(ocamlopt) -o $*.cmx -c $(target-flags) \ - $(ocamlopt-cflags) $< - else - %.obj %.cmx: %.ml :scanner: %.cmx.scan :effects: %.cmi \ - :value: $(caml-emit-stdmake-rule $@) - $(ocamlopt) -o $*.cmx -c $(target-flags) \ - $(ocamlopt-cflags) $< - export -else - %.o %.cmx: %.ml - section rule - if $(target-exists %.mli) - %.o %.cmx: %.ml %.cmi-x %.cmi \ - :value: $(caml-emit-stdmake-rule $@) - $(ocamlopt) -o $*.cmx -c $(target-flags) \ - $(ocamlopt-cflags) $< - else - %.o %.cmx: %.ml :scanner: %.cmx.scan :effects: %.cmi \ - :value: $(caml-emit-stdmake-rule $@) - $(ocamlopt) -o $*.cmx -c $(target-flags) \ - $(ocamlopt-cflags) $< - export - -profile = - if $(defined profile) - value $(profile) - else - value debug - -switch $(profile) -case release - profile-c-cflags[] = -O2 -DNDEBUG - profile-cxx-cflags[] = -O2 -DNDEBUG - export -case debug - profile-c-cflags[] = -DDEBUG - profile-cxx-cflags[] = -DDEBUG - export - -build-dir = build/$(TARGET_OS)/$(profile) - -subdirs[] = - -if $(not $(defined top-dir)) - top-dir = $(dir .) - export top-dir - -add-env(subdir) = - mkdir -p $(build-dir)/$(subdir) - add-project-directories($(subdir)) - -add-env2(subdir) = - mkdir -p $(subdir) - add-project-directories($(top-dir)/$(subdir)) - -create-env(subdirs) = - subdirs += . - foreach(subdir, $(subdirs)) - mkdir -p $(build-dir)/$(subdir) - add-project-directories($(subdirs)) - -create-env($(subdirs)) - -#make-file = $(fopen $(build-dir)/Makefile, w) - -vmount($(top-dir), $(build-dir)) -bin-path = $(dir $(build-dir)/bin) - -mkdir -p $(build-dir) -mkdir -p $(bin-path) - -.PHONY: all clean -.DEFAULT: all -.SUBDIRS: $(build-dir) +OMakeFlags (-w) + +.ORDER: .caml-order +.caml-order: %.cmi: %.cmo +.caml-order: %.cmx: %.cmo + +caml-sort(files) = + return $(file-sort .caml-order, $(files)) + +collect-includes(flags) = + dirs[] = + next = false + foreach (f, $(flags)) + if $(next) + dirs += $f + next = false + export + else + f = $(string $f) + l = $(f.length) + if $(and $(gt $l, 1), \ + $(and $(equal $(f.nth 0), -), \ + $(equal $(f.nth 1), I))) + if $(gt $l, 2) + dirs += $(removeprefix -I, $f) + export + else + next = true + export + export + export + export + return $(dirs) + +Shell. += + pr-list(argv) = + foreach(a, $(argv)) + println($a) + + eecho(argv) = + eprintln($(string $(argv))) + + cmo-scan(argv) = + emacs-helper = directory $"`"$(absname $(dirof $<))\' + eecho "make[0]: Entering $(emacs-helper)" + cd $(dirof $<) + ocamldep $(depflags) $(basename $<) + eecho "make[0]: Leaving $(emacs-helper)" + + cmx-scan(argv) = + emacs-helper = directory $"`"$(absname $(dirof $<))\' + eecho "make[0]: Entering $(emacs-helper)" + cd $(dirof $<) + ocamldep $(depflags) $(basename $<) + eecho "make[0]: Leaving $(emacs-helper)" + +ocamlc(name, flags) = + s = $(name).ml + i = $(name).mli + o = $(name).cmo + I = $(name).cmi + + depflags = $(mapprefix -I, $(collect-includes $(flags))) + + .SCANNER: %.cmo.scan: %.ml + cmo-scan + + if $(file-exists $i) + .SCANNER: %.cmi.scan: %.mli + cmo-scan + + $o: $I + $I: $i :scanner: $I.scan + ocamlc $(flags) -c -o $I $(absname $i) + + $o: $s :scanner: $o.scan + ocamlc $(flags) -c -o $o $(absname $s) + else + $o $I: $s :scanner: $o.scan + ocamlc $(flags) -c -o $o $(absname $s) + +ocamlopt(name, flags) = + s = $(name).ml + i = $(name).mli + o = $(name).cmx + I = $(name).cmi + O = $(name).o + + depflags = $(mapprefix -I, $(collect-includes $(flags))) + + .SCANNER: %.cmx.scan: %.ml + cmx-scan + + if $(file-exists $i) + .SCANNER: %.cmi.scan: %.mli + cmx-scan + +# $o: $I +# $I: $i :scanner: $I.scan +# ocamlopt $(flags) -c -o $I $(absname $i) + + $o $O: $s :scanner: $o.scan + ocamlopt $(flags) -c -o $o $(absname $s) + else + $o $O: $s :scanner: $o.scan + ocamlopt $(flags) -c -o $o $(absname $s) + +Mocamlc(names, flags) = + foreach (n, $(names)) + ocamlc ($n, $(flags)) + +Mocamlopt(names, flags) = + foreach (n, $(names)) + ocamlopt ($n, $(flags)) + +cc(name, flags) = + s = $(name).c + o = $(name).o + + .SCANNER: %.o.scan: %.c + gcc $(flags) -MM -MT $* $< + + $o: $s :scanner: $o.scan + gcc $(flags) -c -o $@ $< + +ocamlcc(name, flags) = + s = $(name).c + o = $(name).o + + .SCANNER: %.o.scan: %.c + ocamlc -ccopt "$(flags) -MM -MT $o" -cc gcc $< + + $o: $s :scanner: $o.scan + ocamlc -ccopt "$(flags) -o $o" -cc gcc $< + +Mcc(names, flags) = + foreach (n, $(names)) + cc($n, $(flags)) + +Mocamlcc(names, flags) = + foreach (n, $(names)) + ocamlcc($n, $(flags)) + +if $(not $(defined srcdir)) + srcdir = $(absname $(dirof OMakeroot)) + export srcdir + +mkdir -p build +add-project-directories (build .) +vmount ($(srcdir), build) +.SUBDIRS: build diff --git a/README b/README index e5a6d01..f8c82a3 100644 --- a/README +++ b/README @@ -1,10 +1,10 @@ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -WARNING + WARNING The kernel module part of this program messes with internal affairs of the kernel, while best effort was put into making it safe, there are: - NO GUARANTEES WHATSOEVER + NO GUARANTEES WHATSOEVER Furthermore removing the previous versions of the module (via rmmod(8)) caused one particular kernel version to panic @@ -23,7 +23,7 @@ of `mod/itc-mod.c'. refuse to build for them. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This is APC - graphical CPU load meter. + This is APC - graphical CPU load meter. It is more suitable/accurate in situations where applications generate "short" periodic bursts of activity. @@ -38,13 +38,20 @@ load time is taken to mean: Con Kolivas in his post on LKML (http://lkml.org/lkml/2007/2/12/7) described the way Linux gathers information that it exports to `/proc/stat' (at least for "boring" architectures), this method is by -no means accurate. +no means accurate and can "lie" in either direction. You can witness this by running the `hog' example and, if stars are aligned correctly, you will notice that something is wrong with what `/proc/stat' claims. Since most of the CPU monitoring applications use `/proc/stat' they will produce incorrect results too. +Kernel (starting with version 2.6.21) comes with a document describing +current the way accounting is currently done and problems with this +approach (Documentation/cpu-load.txt) + +Following thread describes a take on addressing the issue properly: +http://marc.info/?t=117480935100001&r=1&w=2 + Apart from being inaccurate, `/proc/stat' exports monotonically increasing load times but _NOT_ real time[1], so there's omni-present sub-jiffy error. Not to mention that jiffy resolution is somewhat low. @@ -69,6 +76,7 @@ Linux 2.6.17.6 Linux 2.6.19.2 - AMD Athlon(tm)64 X2 Dual Core Processor 3800+ Linux 2.6.18 - AMD Athlon(tm)64 3800+ Linux 2.6.18.3 - PowerPC 7447A +Linux 2.6.20.1 - PowerPC 7447A Linux 2.6.19 - [some Core 2 Duo] It's possible that RMClock[3] does something similar(load measuring @@ -76,7 +84,7 @@ wise) on Microsoft Windows. [1] Unlike `/proc/uptime'. But this one is useless for SMP [2] SMP not tested on 2.4 kernels, nor QUIRK mode. SMP on PPC wasn't - tested at all + tested either [3] http://cpu.rightmark.org/products/rmclock.shtml ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/Thanks b/Thanks index c8b6510..6158c18 100644 --- a/Thanks +++ b/Thanks @@ -3,3 +3,5 @@ Whole OCaml team Jacques Garrigue, Isaac Trotts, Erick Tryzelaar and Christophe Raffali German Zhivotnikov, Alexey Sterjantov + +Con Kolivas, Pavel Machek diff --git a/apc.ml b/apc.ml index a44451c..71aa9cc 100644 --- a/apc.ml +++ b/apc.ml @@ -7,6 +7,67 @@ 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 +;; + +type stats = + { all : float + ; user : float + ; nice : float + ; sys : float + ; idle : float + ; iowait : float + ; intr : float + ; softirq : float + } +;; + +let zero_stat = + { all = 0.0 + ; user = 0.0 + ; nice = 0.0 + ; sys = 0.0 + ; idle = 0.0 + ; iowait = 0.0 + ; intr = 0.0 + ; softirq = 0.0 + } +;; + +let neg_stat a = + { all = -.a.all + ; user = -.a.user + ; nice = -.a.nice + ; sys = -.a.sys + ; idle = -.a.idle + ; iowait = -.a.iowait + ; intr = -.a.intr + ; softirq = -.a.softirq + } +;; + +let scale_stat a s = + { all = a.all *. s + ; user = a.user *. s + ; nice = a.nice *. s + ; sys = a.sys *. s + ; idle = a.idle *. s + ; iowait = a.iowait *. s + ; intr = a.intr *. s + ; softirq = a.softirq *. s + } +;; + +let add_stat a b = + { all = a.all +. b.all + ; user = a.user +. b.user + ; nice = a.nice +. b.nice + ; sys = a.sys +. b.sys + ; idle = a.idle +. b.idle + ; iowait = a.iowait +. b.iowait + ; intr = a.intr +. b.intr + ; softirq = a.softirq +. b.softirq + } +;; module NP = struct type sysinfo = @@ -20,6 +81,7 @@ module NP = struct ; freeswap: int64 ; procs: int64 } + ;; external get_nprocs : unit -> int = "ml_get_nprocs" external idletimeofday : Unix.file_descr -> int -> float array @@ -45,12 +107,14 @@ module NP = struct let jiffies_to_sec j = float j /. hz + ;; let parse_uptime () = let ic = open_in "/proc/uptime" in let vals = Scanf.fscanf ic "%f %f" (fun u i -> (u, i)) in close_in ic; vals + ;; let nprocs = get_nprocs () @@ -78,6 +142,7 @@ module NP = struct `last i else `more (i, fun () -> succ endpos |> parse_int_cont s) + ;; let parse_cpul s = let rec tolist accu = function @@ -95,6 +160,7 @@ module NP = struct vals in cpuname, Array.of_list vals + ;; let parse_stat () = if winnt @@ -125,17 +191,19 @@ module NP = struct let ret = loop nprocs [] in close_in ic; ret + ;; let getselfdir () = try Filename.dirname |< Unix.readlink "/proc/self/exe" with exn -> "./" + ;; end module Args = struct let banner = - [ "Amazing Piece of Code by insanely gifted programmer, Version 0.97c" + [ "Amazing Piece of Code by insanely gifted programmer, Version 0.98" ; "Motivation by: gzh and afs" ; "usage: " ] |> String.concat "\n" @@ -163,6 +231,7 @@ module Args = struct let icon = ref false let labels = ref true let mgrid = ref false + let sepstat = ref false let pad n s = let l = String.length s in @@ -175,6 +244,7 @@ module Args = struct ~src_pos:0 ~len:l ~dst_pos:0; d + ;; let sooo b = if b then "on" else "off" let dA tos s {contents=v} = s ^ " (" ^ tos v ^ ")" @@ -224,6 +294,7 @@ module Args = struct "`uptime' instead of `stat' as kernel sampler (UP only)" ; sB "v" verbose "verbose" ; fB "S" sigway "sigwait delay method" + ; fB "C" sepstat "separate sys/nice/intr/iowait values (kernel sampler)" ; fB "c" scalebar "constant bar width" ; fB "P" poly "filled area instead of lines" ; fB "I" icon "icon (hack)" @@ -247,7 +318,8 @@ module Args = struct "don't know what to do with " ^ s |> prerr_endline; exit 100 ) - banner + banner; + ;; end module Gzh = struct @@ -259,6 +331,7 @@ module Gzh = struct if not !stop && i > 0 then pred i |> furious_cycle else (i, Unix.gettimeofday ()) + ;; let init verbose = let t = 0.5 in @@ -330,6 +403,7 @@ let oohz oohz fn = prev := b; fn () end +;; module Delay = struct let sighandler signr = () @@ -353,6 +427,7 @@ module Delay = struct let t = { Unix.it_interval = v; it_value = v } in let _ = Unix.setitimer Unix.ITIMER_REAL t in () + ;; let delay () = if NP.winnt @@ -369,6 +444,7 @@ module Delay = struct with Unix.Unix_error (Unix.EINTR, _, _) -> () end end + ;; end type sampler = @@ -458,14 +534,17 @@ module View(V: sig val w : int val h : int end) = struct let keyboard ~key ~x ~y = if key = 27 || key = Char.code 'q' then exit 0 + ;; let add dri = funcs := dri :: !funcs + ;; let display () = GlClear.clear [`color]; List.iter (fun (display, _, _) -> display ()) !funcs; Glut.swapBuffers () + ;; let reshape ~w ~h = ww := w; @@ -480,6 +559,7 @@ module View(V: sig val w : int val h : int end) = struct GlMat.translate ~x:~-.1.0 ~y:~-.1.0 (); GlMat.scale ~x:2.0 ~y:2.0 (); Glut.postRedisplay () + ;; let init () = let () = @@ -502,22 +582,25 @@ 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 kload = ref zero_stat + let iload = ref zero_stat let vw = ref 0 let vh = ref 0 let sw = float T.barw /. float !Args.w let bw = ref 0 let m = 1 + let nrcpuscale = 1.0 /. float NP.nprocs let fw = 3 * Glut.bitmapWidth font (Char.code 'W') let ksepsl, isepsl = let base = GlList.gen_lists ~len:2 in GlList.nth base ~pos:0, GlList.nth base ~pos:1 + ;; let getlr = function - | `k -> 0.01, 0.49 - | `i -> 0.51, 0.99 + | `i -> 0.01, 0.49 + | `k -> 0.51, 0.99 + ;; let seps ki = let xl, xr = getlr ki in @@ -580,13 +663,15 @@ module Bar(T: sig val barw : int val bars : int end) = struct ;; let display () = - let kload = min !kload 1.0 |> max 0.0 in - let iload = min !iload 1.0 |> max 0.0 in + let kload = scale_stat !kload nrcpuscale in + let iload = scale_stat !iload nrcpuscale in + let kload_all = min (1.0 -. kload.all) 1.0 |> max 0.0 in + let iload_all = min (1.0 -. iload.all) 1.0 |> max 0.0 in let () = GlDraw.viewport m 0 !bw 15 in let () = GlDraw.color (1.0, 1.0, 1.0); - let kload = 100.0 *. kload in - let iload = 100.0 *. iload in + let kload_all = 100.0 *. kload_all in + let iload_all = 100.0 *. iload_all in let () = GlMat.push (); GlMat.load_identity (); @@ -594,8 +679,8 @@ module Bar(T: sig val barw : int val bars : int end) = struct in let ix = !bw / 2 - fw |> float in let kx = - (fw + !bw / 2) |> float in - let () = sprintf "%5.2f" iload |> draw_string ix 0.0 in - let () = sprintf "%5.2f" kload |> draw_string kx 0.0 in + let () = sprintf "%5.2f" iload_all |> draw_string ix 0.0 in + let () = sprintf "%5.2f" kload_all |> draw_string kx 0.0 in let () = GlMat.pop () in () in @@ -609,7 +694,7 @@ module Bar(T: sig val barw : int val bars : int end) = struct GlMat.translate ~x:~-.1.0 ~y:~-.1.0 (); GlMat.scale ~x:2.0 ~y:(2.0 /. float h) () in - let drawbar load ki = + let aux ki cl = let xl, xr = getlr ki in let drawquad yb yt = GlDraw.begins `quads; @@ -619,25 +704,44 @@ module Bar(T: sig val barw : int val bars : int end) = struct GlDraw.vertex2 (xr, yb); GlDraw.ends () in - let yt = float h *. load in - let yb = 0.0 in - let () = drawquad yb yt in + let fold yb (color, load) = + if load > 0.0 + then + let () = GlDraw.color color in + let yt = yb +. float h *. load in + let () = drawquad yb yt in + yt + else + yb + in + let yb = List.fold_left fold 0.0 cl in let () = GlDraw.color (0.5, 0.5, 0.5) in - let yb = yt in let yt = float h in let () = drawquad yb yt in - drawseps ki + let () = drawseps ki in + () in - GlDraw.color (1.0, 1.0, 0.0); - drawbar iload `k; - GlDraw.color (1.0, 0.0, 0.0); - drawbar kload `i; + let () = + if !Args.sepstat + then + aux `k + [ (1.0, 1.0, 0.0), kload.user + ; (0.0, 0.0, 1.0), kload.nice + ; (1.0, 0.0, 0.0), kload.sys + ; (1.0, 1.0, 1.0), kload.intr + ; (0.75, 0.5, 0.5), (1.0 -. kload.iowait) -. kload.all + ] + else + aux `k [ (1.0, 0.0, 0.0), 1.0 -. kload.idle ] + in + let () = aux `i [ (1.0, 1.0, 0.0), 1.0 -. iload.all ] in GlMat.pop (); ;; - let update kload' iload' = - kload := kload' /. float NP.nprocs; - iload := iload' /. float NP.nprocs; + let update delta' kload' iload' = + let delta = 1.0 /. delta' in + kload := scale_stat kload' delta; + iload := scale_stat iload' delta; ;; end @@ -828,6 +932,7 @@ let getplacements w h n barw = (i, xc, yc) :: accu |> loop |< succ i in loop [] 0, vw, vh +;; let create fd w h = let module S = @@ -869,7 +974,8 @@ let create fd w h = let d = ref 0.0 in let f d' = d := d' in let () = Gzh.gen f in - fun _ _ _ -> (0.0, !d) + fun _ _ _ -> + { zero_stat with all = !d } else if !Args.uptime then @@ -882,18 +988,48 @@ let create fd w h = and di = i2 -. !i1 in u1 := u2; i1 := i2; - (0.0, di /. du) + { zero_stat with all = di /. du } else let i' = if i = NP.nprocs then 0 else succ i in - let n = NP.idle in - let g ks = Array.get ks i' |> snd |> Array.get |< n in - let i1 = g ks |> ref in + let g ks n = Array.get ks i' |> snd |> Array.get |< n in + let gall ks = + let user = g ks NP.user + and nice = g ks NP.nice + and sys = g ks NP.sys + and idle = g ks NP.idle + and iowait = g ks NP.idle + and intr = g ks NP.intr + and softirq = g ks NP.softirq in + let () = + if + !Args.debug + then + Format.eprintf + "user=%f nice=%f sys=%f iowait=%f intr=%f softirq=%f@." + user + nice + sys + iowait + intr + softirq + ; + in + { all = idle + ; user = user + ; nice = nice + ; sys = sys + ; idle = idle + ; iowait = iowait + ; intr = intr + ; softirq = softirq + } + in + let i1 = ref (gall ks) in fun ks t1 t2 -> - let i2 = g ks in - let i1' = !i1 - and i2' = i2 in + let i2 = gall ks in + let diff = add_stat i2 (neg_stat !i1) in i1 := i2; - (i1', i2') + diff in calc, sampler in @@ -920,11 +1056,11 @@ let create fd w h = let i2 = Array.get is i in if classify_float i2 = FP_infinite then - (t1, t2) + { zero_stat with all = t2 -. t1 } else let i1' = !i1 in i1 := i2; - (i1', i2) + { zero_stat with all = i2 -. i1' } in let kaccu = if !Args.ksampler @@ -935,6 +1071,7 @@ let create fd w h = in let kl, il, gl = List.fold_left crgraph ([], [], []) placements in ((if kl == [] then (fun () -> [||]) else kget), kl), (iget, il), gl +;; let opendev path = if NP.winnt @@ -955,10 +1092,17 @@ let opendev path = path s1 s2 |< Unix.error_message Unix.ENOENT; exit 100 + | Unix.Unix_error (error, s1, s2) -> + eprintf "Could not open ITC device %S:\n%s(%s): %s\n" + path s1 s2 |< Unix.error_message error; + eprintf "(perhaps modules is already in use?)@."; + exit 100 + | exn -> eprintf "Could not open ITC device %S:\n%s\n" path |< Printexc.to_string exn; exit 100 +;; let seticon () = let module X = struct external seticon : string -> unit = "ml_seticon" end in @@ -1013,6 +1157,7 @@ let seticon () = let main () = let _ = Glut.init [|""|] in + (* let () = Gl.enable `line_smooth in *) let () = Args.init () in let () = if !Args.verbose @@ -1038,7 +1183,7 @@ let main () = FullV.add (Bar.display, Bar.reshape, fun _ -> ()); Bar.update else - fun _ _ -> () + fun _ _ _ -> () in let seticon = if !Args.icon then seticon () else fun ~iload ~kload -> () in let rec loop t1 () = @@ -1048,11 +1193,11 @@ let main () = then let is = iget () in let ks = kget () in - let rec loop2 load s = function + let rec loop2 load sample = function | [] -> load | (nr, calc, sampler) :: rest -> - let i1, i2 = calc s t1 t2 in - let thisload = 1.0 -. ((i2 -. i1) /. dt) in + let cpuload = calc sample t1 t2 in + let thisload = 1.0 -. (cpuload.all /. dt) in let thisload = max 0.0 thisload in let () = if !Args.verbose @@ -1061,21 +1206,21 @@ let main () = ^ (thisload *. 100.0 |> string_of_float) |> print_endline) in - let load = load +. thisload in - sampler.update t1 t2 i1 i2; - loop2 load s rest + let load = add_stat load cpuload in + sampler.update t1 t2 0.0 load.all; + loop2 load sample rest in - let iload = loop2 0.0 is ifuncs in - let kload = loop2 0.0 ks kfuncs in + let iload = loop2 zero_stat is ifuncs in + let kload = loop2 zero_stat ks kfuncs in if !Args.debug then begin - iload |> string_of_float |> prerr_endline; - kload |> string_of_float |> prerr_endline; + iload.all |> string_of_float |> prerr_endline; + kload.all |> string_of_float |> prerr_endline; end ; - seticon ~iload ~kload; - bar_update kload iload; + seticon ~iload:iload.all ~kload:kload.all; + bar_update dt kload iload; FullV.inc (); FullV.update (); FullV.func (Some (loop t2)) @@ -1084,6 +1229,7 @@ let main () = in FullV.func (Some (Unix.gettimeofday () |> loop)); FullV.run () +;; let _ = try main () @@ -1093,3 +1239,4 @@ let _ = | exn -> Printexc.to_string exn |> eprintf "Exception: %s@." +;; diff --git a/hog.c b/hog.c index 4544fdd..de2db1a 100644 --- a/hog.c +++ b/hog.c @@ -11,7 +11,7 @@ #define HIST 10 -static sig_atomic_t stop; +static volatile sig_atomic_t stop; static void sighandler (int signr) { @@ -49,6 +49,7 @@ int main (void) err (EXIT_FAILURE, "failed to set interval timer"); } + hog (ULONG_MAX); for (i = 0; i < HIST; ++i) { v[i] = ULONG_MAX - hog (ULONG_MAX); } diff --git a/mod/itc-mod.c b/mod/itc-mod.c index 8135ee7..db79371 100644 --- a/mod/itc-mod.c +++ b/mod/itc-mod.c @@ -1,5 +1,7 @@ -/* #define ITC_PREEMPT_HACK */ -/* uncomment the above if APC blatantly lies and PREEMPTION is enabled */ +#ifdef CONFIG_PREEMPT +#define ITC_PREEMPT_HACK +#endif + #include #include #include @@ -64,15 +66,13 @@ MODULE_DESCRIPTION ("Idle time collector"); -static void (*idle_func) (void); - #ifdef CONFIG_X86 -/* there are many ways to prevent gcc from complaining about module_param - and function pointer vs long, but let's not */ +static void (*fidle_func) (void); +static long idle_func; #if LINUX_VERSION_CODE < KERNEL_VERSION (2, 6, 0) MODULE_PARM (idle_func, "l"); #else -module_param (idle_func, long, 0777); +module_param (idle_func, long, 0644); #endif MODULE_PARM_DESC (idle_func, "address of default idle function"); #endif @@ -90,6 +90,7 @@ struct itc int sleeping; }; +static int in_use; static struct itc global_itc[NR_CPUS]; /********************************************************************** @@ -178,10 +179,12 @@ itc_idle (void) { orig_pm_idle (); } +#ifdef CONFIG_X86 else { - idle_func (); + fidle_func (); } +#endif #else if (orig_pm_idle) { @@ -189,11 +192,13 @@ itc_idle (void) } else { - if (idle_func) +#ifdef CONFIG_X86 + if (fidle_func) { - idle_func (); + fidle_func (); } else +#endif { default_idle (); } @@ -245,6 +250,7 @@ itc_release (struct inode * inode, struct file * filp) { itc_enter_bkl (); pm_idle = orig_pm_idle; + in_use = 0; itc_leave_bkl (); #if LINUX_VERSION_CODE >= KERNEL_VERSION (2, 6, 0) /* XXX: 2.4 */ @@ -265,6 +271,11 @@ itc_open (struct inode * inode, struct file * filp) return -ENODEV; } + if (in_use) + { + return -EALREADY; + } + /* old_fops = filp->f_op; */ filp->f_op = fops_get (&itc_fops); fops_put (old_fops); @@ -275,6 +286,7 @@ itc_open (struct inode * inode, struct file * filp) orig_pm_idle = pm_idle; } pm_idle = itc_idle; + in_use = 1; itc_leave_bkl (); return ret; @@ -351,8 +363,16 @@ init (void) { int err; +#ifdef CONFIG_X86 + fidle_func = (void (*) (void)) idle_func; +#endif + #ifdef QUIRK - if (!pm_idle && !idle_func) + if (!pm_idle +#ifdef CONFIG_X86 + && !fidle_func +#endif + ) { printk (KERN_ERR @@ -379,14 +399,20 @@ init (void) orig_pm_idle = pm_idle; printk (KERN_DEBUG - "itc: driver loaded pm_idle=%p default_idle=%p, idle_func=%p\n", - pm_idle, + "itc: driver loaded pm_idle=%p default_idle=%p" +#ifdef CONFIG_X86 + ", idle_func=%p" +#endif + "\n", + pm_idle #ifdef QUIRK - NULL, + , NULL #else - default_idle, + , default_idle +#endif +#ifdef CONFIG_X86 + , fidle_func #endif - idle_func ); printk (KERN_DEBUG "itc: CPUs(%d present=%d online=%d)" #ifdef QUIRK -- 2.11.4.GIT