ref: efd1615c5741a6898853fefc24b1cbcb734e5477
dir: /appl/wm/cprof.b/
implement Wmcprof;
include "sys.m";
sys: Sys;
include "bufio.m";
bufio: Bufio;
Iobuf: import bufio;
include "draw.m";
draw: Draw;
include "tk.m";
tk: Tk;
include "tkclient.m";
tkclient: Tkclient;
include "arg.m";
arg: Arg;
include "profile.m";
Prof: module{
init0: fn(ctxt: ref Draw->Context, argv: list of string): Profile->Coverage;
};
prof: Prof;
Wmcprof: module{
init: fn(ctxt: ref Draw->Context, argl: list of string);
};
usage(s: string)
{
sys->fprint(sys->fildes(2), "wm/cprof: %s\n", s);
sys->fprint(sys->fildes(2), "usage: wm/cprof [-efr] [-m modname]... cmd [arg ... ]\n");
exit;
}
TXTBEGIN: con 3;
freq: int;
init(ctxt: ref Draw->Context, argl: list of string)
{
sys = load Sys Sys->PATH;
bufio = load Bufio Bufio->PATH;
draw = load Draw Draw->PATH;
tk = load Tk Tk->PATH;
tkclient = load Tkclient Tkclient->PATH;
arg = load Arg Arg->PATH;
if(ctxt == nil)
fatal("wm not running");
sys->pctl(Sys->NEWPGRP, nil);
arg->init(argl);
while((o := arg->opt()) != 0){
case(o){
'e' or 'r' =>
;
'f' =>
freq = 1;
'm' =>
if(arg->arg() == nil)
usage("missing module/file");
* =>
usage(sys->sprint("unknown option -%c", o));
}
}
cover := execprof(ctxt, argl);
tkclient->init();
(win, wmc) := tkclient->toplevel(ctxt, nil, hd argl, Tkclient->Resize|Tkclient->Hide);
tkc := chan of string;
tk->namechan(win, tkc, "tkc");
for(i := 0; i < len wincfg; i++)
cmd(win, wincfg[i]);
tkclient->onscreen(win, nil);
tkclient->startinput(win, "kbd"::"ptr"::nil);
createmenu(win, cover);
curc := 0;
curm := newprint(win, cover, curc);
for(;;){
alt{
c := <-win.ctxt.kbd =>
tk->keyboard(win, c);
c := <-win.ctxt.ptr =>
tk->pointer(win, *c);
c := <-win.ctxt.ctl or
c = <-win.wreq or
c = <-wmc =>
tkclient->wmctl(win, c);
c := <- tkc =>
(nil, toks) := sys->tokenize(c, " ");
case(hd toks){
"b" =>
if(curc > 0)
curm = newprint(win, cover, --curc);
"f" =>
if(curc < len cover - 1)
curm = newprint(win, cover, ++curc);
"s" =>
if(curm != nil)
scroll(win, curm);
"m" =>
x := cmd(win, ".f cget actx");
y := cmd(win, ".f cget acty");
cmd(win, ".f.menu post " + x + " " + y);
* =>
curc = int hd toks;
curm = newprint(win, cover, curc);
}
}
}
}
execprof(ctxt: ref Draw->Context, argl: list of string): Profile->Coverage
{
{
prof = load Prof "/dis/cprof.dis";
if(prof == nil)
fatal("cannot load profiler");
return prof->init0(ctxt, hd argl :: "-g" :: tl argl);
}
exception{
"fail:*" =>
return nil;
}
return nil;
}
maxf(rs: list of (int, int, int)): int
{
fmax := 0;
for(r := rs; r != nil; r = tl r){
(nil, nil, f) := hd r;
if(f > fmax)
fmax = f;
}
return fmax;
}
print(win: ref Tk->Toplevel, cvr: Profile->Coverage, i: int, c: chan of Profile->Coverage)
{
cmd(win, ".f.t delete 1.0 end");
cmd(win, "update");
m0, m1: Profile->Coverage;
for(m := cvr; m != nil && --i >= 0; m = tl m)
m0 = m;
if(m == nil){
c <- = nil;
return;
}
m1 = tl m;
(name, cvd, ls) := hd m;
name0 := name1 := "nil";
if(m0 != nil)
(name0, nil, nil) = hd m0;
if(m1 != nil)
(name1, nil, nil) = hd m1;
if(freq){
cvd = 0;
for(l := ls; l != nil; l = tl l){
(rs, nil) := hd l;
cvd += maxf(rs);
}
}
else
name += sys->sprint(" (%d%% coverage) ", cvd);
cmd(win, ".f.t insert end {" + name + " <- " + name0 + " -> " + name1 + "}");
cmd(win, ".f.t insert end \n\n");
cmd(win, "update");
line := TXTBEGIN;
for(l := ls; l != nil; l = tl l){
tab := 0;
(rs, s) := hd l;
if(freq){
fmax := maxf(rs);
s = string fmax + "\t" + s;
tab = len string fmax + 1;
}
cmd(win, ".f.t insert end " + tk->quote(s));
for(r := rs; r != nil; r = tl r){
tag: string;
(a, b, e) := hd r;
if(freq){
tag = gettag(win, e, cvd);
a += tab;
b += tab;
}
else{
if(int e) # partly executed
tag = "halfexec";
else
tag = "notexec";
}
cmd(win, ".f.t tag add " + tag + " " + string line + "." + string a + " " + string line + "." + string b);
}
cmd(win, "update");
line++;
}
c <- = m;
}
newprint(win: ref Tk->Toplevel, cvr: Profile->Coverage, i: int): Profile->Coverage
{
c := chan of Profile->Coverage;
spawn print(win, cvr, i, c);
return <- c;
}
index(win: ref Tk->Toplevel, x: int, y: int): int
{
t := cmd(win, ".f.t index @" + string x + "," + string y);
(nil, l) := sys->tokenize(t, ".");
# sys->print("%d,%d -> %s\n", x, y, t);
return int hd l;
}
winextent(win: ref Tk->Toplevel): (int, int)
{
w := int cmd(win, ".f.t cget -actwidth");
h := int cmd(win, ".f.t cget -actheight");
lw := index(win, 0, 0);
uw := index(win, w-1, h-1);
return (lw, uw);
}
see(win: ref Tk->Toplevel, line: int)
{
cmd(win, ".f.t see " + string line + ".0");
cmd(win, "update");
}
scroll(win: ref Tk->Toplevel, m: Profile->Coverage)
{
(nil, cvd, ls) := hd m;
if(freq)
cvd = 0;
(nil, uw) := winextent(win);
line := TXTBEGIN;
for(l := ls; l != nil; l = tl l){
(rs, nil) := hd l;
if(rs != nil && line > uw){
see(win, line);
return;
}
line++;
}
if(cvd < 100){
line = TXTBEGIN;
for(l = ls; l != nil; l = tl l){
(rs, nil) := hd l;
if(rs != nil){
see(win, line);
return;
}
line++;
}
}
return;
}
cmd(top: ref Tk->Toplevel, s: string): string
{
# sys->print("%s\n", s);
e := tk->cmd(top, s);
if (e != nil && e[0] == '!')
sys->fprint(sys->fildes(2), "tk error on '%s': %s\n", s, e);
return e;
}
fatal(s: string)
{
sys->fprint(sys->fildes(2), "%s\n", s);
exit;
}
MENUMAX: con 20;
createmenu(top: ref Tk->Toplevel, cvr: Profile->Coverage )
{
mn := ".f.menu";
cmd(top, "menu " + mn);
i := j := 0;
for(m := cvr; m != nil; m = tl m){
(name, nil, nil) := hd m;
cmd(top, mn + " add command -label " + name + " -command {send tkc " + string i + "}");
i++;
j++;
if(j == MENUMAX && tl m != nil){
cmd(top, mn + " add cascade -label MORE -menu " + mn + ".menu");
mn += ".menu";
cmd(top, "menu " + mn);
j = 0;
}
}
}
SNT: con 16;
NT: con SNT*SNT;
NTF: con 256/SNT;
tags := array[NT] of { * => byte 0 };
gettag(win: ref Tk->Toplevel, n: int, d: int): string
{
i := int ((real n/real d) * real (NT-1));
if(i < 0 || i > NT-1)
i = 0;
s := "tag" + string i;
if(tags[i] == byte 0){
rgb := "#" + hex2(255-NTF*0)+hex2(255-NTF*(i/SNT))+hex2(255-NTF*(i%SNT));
cmd(win, ".f.t tag configure " + s + " -fg black -bg " + rgb);
tags[i] = byte 1;
}
return s;
}
hex(i: int): int
{
if(i < 10)
return i+'0';
else
return i-10+'A';
}
hex2(i: int): string
{
s := "00";
s[0] = hex(i/16);
s[1] = hex(i%16);
return s;
}
wincfg := array[] of {
"frame .f",
"text .f.t -width 809 -height 500 -state disabled -wrap char -bg white -yscrollcommand {.f.s set}",
"scrollbar .f.s -orient vertical -command {.f.t yview}",
"frame .i",
"button .i.b -bitmap small_color_left.bit -command {send tkc b}",
"button .i.f -bitmap small_color_right.bit -command {send tkc f}",
"button .i.s -bitmap small_find.bit -command {send tkc s}",
"button .i.m -bitmap small_reload.bit -command {send tkc m}",
"pack .i.b -side left",
"pack .i.f -side left",
"pack .i.s -side left",
"pack .i.m -side left",
"pack .f.s -fill y -side left",
"pack .f.t -fill both -expand 1",
"pack .i -fill x",
"pack .f -fill both -expand 1",
"pack propagate . 0",
".f.t tag configure notexec -fg white -bg red",
".f.t tag configure halfexec -fg red -bg white",
"update",
};