1implement Wmprof; 2 3include "sys.m"; 4 sys: Sys; 5include "bufio.m"; 6 bufio: Bufio; 7 Iobuf: import bufio; 8include "draw.m"; 9 draw: Draw; 10include "tk.m"; 11 tk: Tk; 12include "tkclient.m"; 13 tkclient: Tkclient; 14include "arg.m"; 15 arg: Arg; 16include "profile.m"; 17 18Prof: module{ 19 init0: fn(ctxt: ref Draw->Context, argv: list of string): Profile->Prof; 20}; 21 22prof: Prof; 23 24Wmprof: module{ 25 init: fn(ctxt: ref Draw->Context, argl: list of string); 26}; 27 28usage(s: string) 29{ 30 sys->fprint(sys->fildes(2), "wm/prof: %s\n", s); 31 sys->fprint(sys->fildes(2), "usage: wm/prof [-e] [-m modname]... cmd [arg ... ]\n"); 32 exit; 33} 34 35TXTBEGIN: con 3; 36 37init(ctxt: ref Draw->Context, argl: list of string) 38{ 39 sys = load Sys Sys->PATH; 40 bufio = load Bufio Bufio->PATH; 41 draw = load Draw Draw->PATH; 42 tk = load Tk Tk->PATH; 43 tkclient = load Tkclient Tkclient->PATH; 44 arg = load Arg Arg->PATH; 45 46 if(ctxt == nil) 47 fatal("wm not running"); 48 sys->pctl(Sys->NEWPGRP, nil); 49 50 arg->init(argl); 51 while((o := arg->opt()) != 0){ 52 case(o){ 53 'e' => ; 54 'm' => 55 if(arg->arg() == nil) 56 usage("missing module/file"); 57 's' => 58 if(arg->arg() == nil) 59 usage("missing sample rate"); 60 * => 61 usage(sys->sprint("unknown option -%c", o)); 62 } 63 } 64 65 stats := execprof(ctxt, argl); 66 if(stats.mods == nil) 67 exit; 68 69 tkclient->init(); 70 (win, wmc) := tkclient->toplevel(ctxt, nil, hd argl, Tkclient->Resize|Tkclient->Hide); 71 tkc := chan of string; 72 tk->namechan(win, tkc, "tkc"); 73 for(i := 0; i < len wincfg; i++) 74 cmd(win, wincfg[i]); 75 tkclient->onscreen(win, nil); 76 tkclient->startinput(win, "kbd"::"ptr"::nil); 77 createmenu(win, stats); 78 curc := 0; 79 cura := newprint(win, stats, curc); 80 81 for(;;){ 82 alt{ 83 c := <-win.ctxt.kbd => 84 tk->keyboard(win, c); 85 c := <-win.ctxt.ptr => 86 tk->pointer(win, *c); 87 c := <-win.ctxt.ctl or 88 c = <-win.wreq or 89 c = <-wmc => 90 tkclient->wmctl(win, c); 91 c := <- tkc => 92 (nil, toks) := sys->tokenize(c, " "); 93 case(hd toks){ 94 "b" => 95 if(curc > 0) 96 cura = newprint(win, stats, --curc); 97 "f" => 98 if(curc < len stats.mods - 1) 99 cura = newprint(win, stats, ++curc); 100 "s" => 101 if(cura != nil) 102 scroll(win, cura); 103 "m" => 104 x := cmd(win, ".f cget actx"); 105 y := cmd(win, ".f cget acty"); 106 cmd(win, ".f.menu post " + x + " " + y); 107 * => 108 curc = int hd toks; 109 cura = newprint(win, stats, curc); 110 } 111 } 112 } 113} 114 115execprof(ctxt: ref Draw->Context, argl: list of string): Profile->Prof 116{ 117 { 118 prof = load Prof "/dis/prof.dis"; 119 if(prof == nil) 120 fatal("cannot load profiler"); 121 return prof->init0(ctxt, hd argl :: "-g" :: tl argl); 122 } 123 exception{ 124 "fail:*" => 125 return (nil, 0, nil); 126 } 127 return (nil, 0, nil); 128} 129 130newprint(win: ref Tk->Toplevel, p: Profile->Prof, i: int): array of int 131{ 132 cmd(win, ".f.t delete 1.0 end"); 133 cmd(win, "update"); 134 m0, m1: list of Profile->Modprof; 135 for(m := p.mods; m != nil && --i >= 0; m = tl m) 136 m0 = m; 137 if(m == nil) 138 return nil; 139 m1 = tl m; 140 (name, nil, spath, nil, line, nil, nil, tot, nil, nil) := hd m; 141 name0 := name1 := "nil"; 142 if(m0 != nil) 143 name0 = (hd m0).name; 144 if(m1 != nil) 145 name1 = (hd m1).name; 146 a := len name; 147 name += sys->sprint(" (%d%%) ", percent(tot, p.total)); 148 cmd(win, ".f.t insert end {" + name + " <- " + name0 + " -> " + name1 + "}"); 149 tag := gettag(win, tot, p.total); 150 cmd(win, ".f.t tag add " + tag + " " + "1.0" + " " + "1." + string a); 151 cmd(win, ".f.t insert end \n\n"); 152 cmd(win, "update"); 153 lineno := TXTBEGIN; 154 bio := bufio->open(spath, Bufio->OREAD); 155 if(bio == nil) 156 return nil; 157 i = 1; 158 ll := len line; 159 while((s := bio.gets('\n')) != nil){ 160 f := 0; 161 if(i < ll) 162 f = line[i]; 163 a = len s; 164 if(f > 0) 165 s = sys->sprint("%d%%\t%s", percent(f, tot), s); 166 else 167 s = sys->sprint("- \t%s", s); 168 b := len s; 169 cmd(win, ".f.t insert end " + tk->quote(s)); 170 tag = gettag(win, f, tot); 171 cmd(win, ".f.t tag add " + tag + " " + string lineno + "." + string (b-a) + " " + string lineno + "." + string (b-1)); 172 cmd(win, "update"); 173 lineno++; 174 i++; 175 } 176 return line; 177} 178 179index(win: ref Tk->Toplevel, x: int, y: int): int 180{ 181 t := cmd(win, ".f.t index @" + string x + "," + string y); 182 (nil, l) := sys->tokenize(t, "."); 183# sys->print("%d,%d -> %s\n", x, y, t); 184 return int hd l; 185} 186 187winextent(win: ref Tk->Toplevel): (int, int) 188{ 189 w := int cmd(win, ".f.t cget -actwidth"); 190 h := int cmd(win, ".f.t cget -actheight"); 191 lw := index(win, 0, 0); 192 uw := index(win, w-1, h-1); 193 return (lw, uw); 194} 195 196see(win: ref Tk->Toplevel, line: int) 197{ 198 cmd(win, ".f.t see " + string line + ".0"); 199 cmd(win, "update"); 200} 201 202scroll(win: ref Tk->Toplevel, line: array of int) 203{ 204 (nil, uw) := winextent(win); 205 lno := TXTBEGIN; 206 ll := len line; 207 for(i := 1; i < ll; i++){ 208 n := line[i]; 209 if(n > 0 && lno > uw){ 210 see(win, lno); 211 return; 212 } 213 lno++; 214 } 215 lno = TXTBEGIN; 216 ll = len line; 217 for(i = 1; i < ll; i++){ 218 n := line[i]; 219 if(n > 0){ 220 see(win, lno); 221 return; 222 } 223 lno++; 224 } 225} 226 227cmd(top: ref Tk->Toplevel, s: string): string 228{ 229 # sys->print("%s\n", s); 230 e := tk->cmd(top, s); 231 if (e != nil && e[0] == '!') 232 sys->fprint(sys->fildes(2), "tk error on '%s': %s\n", s, e); 233 return e; 234} 235 236fatal(s: string) 237{ 238 sys->fprint(sys->fildes(2), "%s\n", s); 239 exit; 240} 241 242MENUMAX: con 20; 243 244createmenu(top: ref Tk->Toplevel, p: Profile->Prof ) 245{ 246 mn := ".f.menu"; 247 cmd(top, "menu " + mn); 248 i := j := 0; 249 for(m := p.mods; m != nil; m = tl m){ 250 name := (hd m).name; 251 cmd(top, mn + " add command -label " + name + " -command {send tkc " + string i + "}"); 252 i++; 253 j++; 254 if(j == MENUMAX && tl m != nil){ 255 cmd(top, mn + " add cascade -label MORE -menu " + mn + ".menu"); 256 mn += ".menu"; 257 cmd(top, "menu " + mn); 258 j = 0; 259 } 260 } 261} 262 263tags := array[256] of { * => byte 0 }; 264 265gettag(win: ref Tk->Toplevel, n: int, d: int): string 266{ 267 i := int ((real n/real d) * real 15); 268 if(i < 0 || i > 15) 269 i = 0; 270 s := "tag" + string i; 271 if(tags[i] == byte 0){ 272 rgb := "#" + hex2(255-64*0)+hex2(255-64*(i/4))+hex2(255-64*(i%4)); 273 cmd(win, ".f.t tag configure " + s + " -fg black -bg " + rgb); 274 tags[i] = byte 1; 275 } 276 return s; 277} 278 279percent(n: int, d: int): int 280{ 281 return int ((real n/real d) * real 100); 282} 283 284hex(i: int): int 285{ 286 if(i < 10) 287 return i+'0'; 288 else 289 return i-10+'A'; 290} 291 292hex2(i: int): string 293{ 294 s := "00"; 295 s[0] = hex(i/16); 296 s[1] = hex(i%16); 297 return s; 298} 299 300wincfg := array[] of { 301 "frame .f", 302 "text .f.t -width 809 -height 500 -state disabled -wrap char -bg white -yscrollcommand {.f.s set}", 303 "scrollbar .f.s -orient vertical -command {.f.t yview}", 304 "frame .i", 305 "button .i.b -bitmap small_color_left.bit -command {send tkc b}", 306 "button .i.f -bitmap small_color_right.bit -command {send tkc f}", 307 "button .i.s -bitmap small_find.bit -command {send tkc s}", 308 "button .i.m -bitmap small_reload.bit -command {send tkc m}", 309 310 "pack .i.b -side left", 311 "pack .i.f -side left", 312 "pack .i.s -side left", 313 "pack .i.m -side left", 314 315 "pack .f.s -fill y -side left", 316 "pack .f.t -fill both -expand 1", 317 318 "pack .i -fill x", 319 "pack .f -fill both -expand 1", 320 "pack propagate . 0", 321 322 "update", 323}; 324