ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/deb.b/
implement WmDebugger; include "sys.m"; sys: Sys; stderr: ref Sys->FD; include "string.m"; str: String; include "arg.m"; arg: Arg; include "readdir.m"; readdir: Readdir; include "draw.m"; draw: Draw; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "dialog.m"; dialog: Dialog; include "selectfile.m"; selectfile: Selectfile; include "tabs.m"; tabs: Tabs; include "debug.m"; debug: Debug; Prog, Exp, Module, Src, Sym: import debug; include "wmdeb.m"; debdata: DebData; Vars: import debdata; debsrc: DebSrc; opendir, Mod: import debsrc; WmDebugger: module { init: fn(ctxt: ref Draw->Context, argv: list of string); }; icondir : con "debug/"; tkconfig := array[] of { "frame .m -relief raised -bd 1", "frame .p -padx 2", "frame .ctls -padx 2", "frame .body", # menu bar "menubutton .m.file -text File -menu .m.file.menu", "menubutton .m.search -text Search -menu .m.search.menu", "button .m.stack -text Stack -command {send m stack}", "pack .m.file .m.search .m.stack -side left", # file menu "menu .m.file.menu", ".m.file.menu add command -label Open... -command {send m open}", ".m.file.menu add command -label Thread... -command {send m pickup}", ".m.file.menu add command -label Options... -command {send m options}", ".m.file.menu add separator", # search menu "menu .m.search.menu", ".m.search.menu add command -state disabled"+ " -label Look -command {send m look}", ".m.search.menu add command -state disabled"+ " -label {Search For} -command {send m search}", # program control "image create bitmap Detach -file "+icondir+ "detach.bit -maskfile "+icondir+"detach.mask", "image create bitmap Kill -file "+icondir+ "kill.bit -maskfile "+icondir+"kill.mask", "image create bitmap Run -file "+icondir+ "run.bit -maskfile "+icondir+"run.mask", "image create bitmap Stop -file "+icondir+ "stop.bit -maskfile "+icondir+"stop.mask", "image create bitmap Bpt -file "+icondir+ "break.bit -maskfile "+icondir+"break.mask", "image create bitmap Stepop -file "+icondir+ "stepop.bit -maskfile "+icondir+"stepop.mask", "image create bitmap Stepin -file "+icondir+ "stepin.bit -maskfile "+icondir+"stepin.mask", "image create bitmap Stepout -file "+icondir+ "stepout.bit -maskfile "+icondir+"stepout.mask", "image create bitmap Stepover -file "+icondir+ "stepover.bit -maskfile "+icondir+"stepover.mask", "button .p.kill -image Kill -command {send m killall}"+ " -state disabled -relief sunken", "bind .p.kill <Enter> +{.p.status configure -text {kill current process}}", "bind .p.kill <Leave> +{.p.status configure -text {}}", "button .p.detach -image Detach -command {send m detach}"+ " -state disabled -relief sunken", "bind .p.detach <Enter> +{.p.status configure -text {stop debugging current process}}", "bind .p.detach <Leave> +{.p.status configure -text {}}", "button .p.run -image Run -command {send m run}"+ " -state disabled -relief sunken", "bind .p.run <Enter> +{.p.status configure -text {run to breakpoint}}", "bind .p.run <Leave> +{.p.status configure -text {}}", "button .p.step -image Stepop -command {send m step}"+ " -state disabled -relief sunken", "bind .p.step <Enter> +{.p.status configure -text {step one operation}}", "bind .p.step <Leave> +{.p.status configure -text {}}", "button .p.stmt -image Stepin -command {send m stmt}"+ " -state disabled -relief sunken", "bind .p.stmt <Enter> +{.p.status configure -text {step one statement}}", "bind .p.stmt <Leave> +{.p.status configure -text {}}", "button .p.over -image Stepover -command {send m over}"+ " -state disabled -relief sunken", "bind .p.over <Enter> +{.p.status configure -text {step over calls}}", "bind .p.over <Leave> +{.p.status configure -text {}}", "button .p.out -image Stepout -command {send m out}"+ " -state disabled -relief sunken", "bind .p.out <Enter> +{.p.status configure -text {step out of fn}}", "bind .p.out <Leave> +{.p.status configure -text {}}", "button .p.bpt -image Bpt -command {send m setbpt}"+ " -state disabled -relief sunken", "bind .p.bpt <Enter> +{.p.status configure -text {set/clear breakpoint}}", "bind .p.bpt <Leave> +{.p.status configure -text {}}", "frame .p.steps", "label .p.status -anchor w", "pack .p.step .p.stmt .p.over .p.out -in .p.steps -side left -fill y", "pack .p.kill .p.detach .p.run .p.steps .p.bpt -side left -padx 5 -fill y", "pack .p.status -side left -expand 1 -fill x", # progs "frame .prog", "label .prog.l -text Threads", "canvas .prog.d -height 1 -width 1 -relief sunken -bd 2", "frame .prog.v", ".prog.d create window 0 0 -window .prog.v -anchor nw", "pack .prog.l -side top -anchor w", "pack .prog.d -side left -fill both -expand 1", # breakpoints "frame .bpt", "label .bpt.l -text Break", "canvas .bpt.d -height 1 -width 1 -relief sunken -bd 2", "frame .bpt.v", ".bpt.d create window 0 0 -window .bpt.v -anchor nw", "pack .bpt.l -side top -anchor w", "pack .bpt.d -side left -fill both -expand 1", "pack .prog .bpt -side top -fill both -expand 1 -in .ctls", # test body "frame .body.ft -bd 1 -relief sunken -width 60w -height 20h", "scrollbar .body.scy", "pack .body.scy -side right -fill y", "pack .body.ft -side top -expand 1 -fill both", "pack propagate .body.ft 0", "pack .m .p -side top -fill x", "pack .ctls -side left -fill y", "scrollbar .body.scx -orient horizontal", "pack .body.scx -side bottom -fill x", "pack .body -expand 1 -fill both", "pack propagate . 0", "raise .; update; cursor -default" }; # commands for disabling or enabling buttons searchoff := array[] of { ".m.search.menu entryconfigure 0 -state disabled", ".m.search.menu entryconfigure 1 -state disabled", ".m.search.menu entryconfigure 2 -state disabled", }; searchon := array[] of { ".m.search.menu entryconfigure 0 -state normal", ".m.search.menu entryconfigure 1 -state normal", ".m.search.menu entryconfigure 2 -state normal", }; tkstopped := array[] of { ".p.bpt configure -state normal -relief raised", ".p.detach configure -state normal -relief raised", ".p.kill configure -state normal -relief raised", ".p.out configure -state normal -relief raised", ".p.over configure -state normal -relief raised", ".p.run configure -state normal -relief raised -image Run -command {send m run}", ".p.step configure -state normal -relief raised", ".p.stmt configure -state normal -relief raised", }; tkrunning := array[] of { ".p.bpt configure -state normal -relief raised", ".p.detach configure -state normal -relief raised", ".p.kill configure -state normal -relief raised", ".p.out configure -state disabled -relief sunken", ".p.over configure -state disabled -relief sunken", ".p.run configure -state normal -relief raised -image Stop -command {send m stop}", ".p.step configure -state disabled -relief sunken", ".p.stmt configure -state disabled -relief sunken", }; tkexited := array[] of { ".p.bpt configure -state normal -relief raised", ".p.detach configure -state normal -relief raised", ".p.kill configure -state normal -relief raised", ".p.out configure -state disabled -relief sunken", ".p.over configure -state disabled -relief sunken", ".p.run configure -state disabled -relief sunken -image Run -command {send m run}", ".p.step configure -state disabled -relief sunken", ".p.stmt configure -state disabled -relief sunken", ".p.stop configure -state disabled -relief sunken", }; tkloaded := array[] of { ".p.bpt configure -state normal -relief raised", ".p.detach configure -state disabled -relief sunken", ".p.kill configure -state disabled -relief sunken", ".p.out configure -state disabled -relief sunken", ".p.over configure -state disabled -relief sunken", ".p.run configure -state normal -relief raised -image Run -command {send m run}", ".p.step configure -state disabled -relief sunken", ".p.stmt configure -state disabled -relief sunken", }; tknobody := array[] of { ".p.bpt configure -state disabled -relief sunken", ".p.detach configure -state disabled -relief sunken", ".p.kill configure -state disabled -relief sunken", ".p.out configure -state disabled -relief sunken", ".p.over configure -state disabled -relief sunken", ".p.run configure -state disabled -relief sunken -image Run -command {send m run}", ".p.step configure -state disabled -relief sunken", ".p.stmt configure -state disabled -relief sunken", }; #tk option dialog tkoptpack := array[] of { "frame .buts", "pack .opts -side left -padx 10 -pady 5", }; tkoptions := array[] of { # general options "frame .gen", "frame .mod", "label .modlab -text 'Source of executable module", "entry .modent", "pack .modlab -in .mod -anchor w", "pack .modent -in .mod -fill x", "frame .arg", "label .arglab -text 'Program Arguments", "entry .argent -width 300", "pack .arglab -in .arg -anchor w", "pack .argent -in .arg -fill x", "frame .wd", "label .wdlab -text 'Working Directory", "entry .wdent", "pack .wdlab -in .wd -anchor w", "pack .wdent -in .wd -fill x", "pack .mod .arg .wd -fill x -anchor w -pady 10 -in .gen", # thread control options "frame .prog", "frame .new", "radiobutton .new.run -variable new -value r -text 'Run new threads", "radiobutton .new.block -variable new -value b -text 'Block new threads", "pack .new.block .new.run -anchor w", "frame .x", "radiobutton .x.kill -variable exit -value k -text 'Kill threads on exit", "radiobutton .x.detach -variable exit -value d -text 'Detach threads on exit", "pack .x.kill .x.detach -anchor w", "pack .new .x -expand 1 -anchor w -in .prog", # layout options "frame .layout", "frame .line", "radiobutton .line.wrap -variable wrap -value w -text 'Wrap lines", "radiobutton .line.scroll -variable wrap -value s -text 'Horizontal scroll", "pack .line.wrap .line.scroll -anchor w", "frame .crlf", "radiobutton .crlf.no -variable crlf -value n -text 'CR/LF as is", "radiobutton .crlf.yes -variable crlf -value y -text 'CR/LF -> LF", "pack .crlf.no .crlf.yes -anchor w", "pack .line .crlf -expand 1 -anchor w -in .layout", }; tkopttabs := array[] of { ("General", ".gen"), ("Thread", ".prog"), ("Layout", ".layout"), }; # prog listing dialog box tkpicktab := array[] of { "frame .progs", "scrollbar .progs.s -command '.progs.p yview", "listbox .progs.p -width 35w -yscrollcommand '.progs.s set", "bind .progs.p <Double-Button-1> 'send cmd prog", "pack .progs.s -side right -fill y", "pack .progs.p -fill both -expand 1", "frame .buts", "button .buts.prog -text {Add Thread} -command 'send cmd prog", "button .buts.grp -text {Add Group} -command 'send cmd group", "pack .buts.prog .buts.grp -expand 1 -side left -fill x -padx 4 -pady 4", "pack .progs -fill both -expand 1", "pack .buts -fill x", "pack propagate . 0", }; Bpt: adt { id: int; m: ref Mod; pc: int; }; Recv, Send, Alt, Running, Stopped, Exited, Broken, Killing, Killed: con iota; status := array[] of { Running => "Running", Recv => "Receive", Send => "Send", Alt => "Alt", Stopped => "Stopped", Exited => "Exited", Broken => "Broken", Killing => "Killed", Killed => "Killed", }; tktools : array of array of string; toolstate : array of string; KidGrab, KidStep, KidStmt, KidOver, KidOut, KidKill, KidRun: con iota; Kid: adt { state: int; prog: ref Prog; watch: int; # pid of watching prog run: int; # pid of stepping prog pickup: int; # picking up this kid? cmd: chan of int; stack: ref Vars; }; Options: adt { start: string; # src of module to start mod: ref Mod; # module to start wm: int; # program is a wm program? path: array of string;# search path for .src and .sbl args: list of string; # argument for starting a kid dir: string; # . for kid tabs: int; # options to show nrun: int; # run new kids? xkill: int; # kill kids on exit? xscroll: int; # horizontal scrolling remcr: int; # CR/LF -> LF }; tktop: ref Tk->Toplevel; kids: list of ref Kid; kid: ref Kid; kidctxt: ref Draw->Context; kidack: chan of (ref Kid, string); kidevent: chan of (ref Kid, string); bpts: list of ref Bpt; bptid:= 1; title: string; runok := 0; context: ref Draw->Context; opts: ref Options; dbpid: int; searchfor: string; initsrc: string; badmodule(p: string) { sys->fprint(sys->fildes(2), "deb: cannot load %s: %r\n", p); raise "fail:bad module"; } init(ctxt: ref Draw->Context, argv: list of string) { sys = load Sys Sys->PATH; if (ctxt == nil) { sys->fprint(sys->fildes(2), "deb: no window context\n"); raise "fail:bad context"; } draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; if(tkclient == nil) badmodule(Tkclient->PATH); selectfile = load Selectfile Selectfile->PATH; if(selectfile == nil) badmodule(Selectfile->PATH); dialog = load Dialog Dialog->PATH; if(dialog == nil) badmodule(Dialog->PATH); tabs = load Tabs Tabs->PATH; if(tabs == nil) badmodule(Tabs->PATH); str = load String String->PATH; if(str == nil) badmodule(String->PATH); readdir = load Readdir Readdir->PATH; if(readdir == nil) badmodule(Readdir->PATH); debug = load Debug Debug->PATH; if(debug == nil) badmodule(Debug->PATH); debdata = load DebData DebData->PATH; if(debdata == nil) badmodule(DebData->PATH); debsrc = load DebSrc DebSrc->PATH; if(debsrc == nil) badmodule(DebSrc->PATH); arg = load Arg Arg->PATH; if(arg == nil) badmodule(Arg->PATH); dbpid = sys->pctl(Sys->NEWPGRP, nil); opts = ref Options; opts.tabs = 0; opts.nrun = 0; opts.xkill = 1; opts.xscroll = 0; opts.remcr = 0; readopts(opts); sysnam := sysname(); context = ctxt; grabpids: list of int; arg->init(argv); arg->setusage("wmdeb [-p pid]"); while((opt := arg->opt()) != 0){ case opt { 'f' => initsrc = arg->earg(); 'p' => grabpids = int arg->earg() :: grabpids; * => arg->usage(); } } for(argv = arg->argv(); argv != nil; argv = tl argv) grabpids = int hd argv :: grabpids; arg = nil; pickdummy := chan of int; pickchan := pickdummy; optdummy := chan of ref Options; optchan := optdummy; tktools = array[] of { Running => tkrunning, Recv => tkrunning, Send => tkrunning, Alt => tkrunning, Stopped => tkstopped, Exited => tkexited, Broken => tkexited, Killing => tkexited, Killed => tkexited, }; tkclient->init(); selectfile->init(); dialog->init(); tabs->init(); title = sysnam+":Wmdeb"; titlebut := chan of string; (tktop, titlebut) = tkclient->toplevel(context, nil, title, Tkclient->Appl); tkcmd("cursor -bitmap cursor.wait"); debug->init(); kidctxt = ctxt; stderr = sys->fildes(2); debsrc->init(context, tktop, tkclient, selectfile, dialog, str, debug, opts.xscroll, opts.remcr); (datatop, datactl, datatitle) := debdata->init(context, nil, debsrc, str, debug); m := chan of string; tk->namechan(tktop, m, "m"); toolstate = tknobody; tkcmds(tktop, tkconfig); if(!opts.xscroll){ tkcmd("pack forget .body.scx"); tkcmd("pack .body -expand 1 -fill both; update"); } tkcmd("cursor -default"); tkclient->onscreen(tktop, nil); tkclient->startinput(tktop, "kbd" :: "ptr" :: nil); kids = nil; kid = nil; kidack = chan of (ref Kid, string); kidevent = chan of (ref Kid, string); # pick up a src file, a kid? if(initsrc != nil) open1(initsrc); else if(grabpids != nil) for(; grabpids != nil; grabpids = tl grabpids) pickup(hd grabpids); for(exiting := 0; !exiting || kids != nil; ){ tkcmd("update"); alt { c := <-tktop.ctxt.kbd => tk->keyboard(tktop, c); p := <-tktop.ctxt.ptr => tk->pointer(tktop, *p); s := <-tktop.ctxt.ctl or s = <-tktop.wreq or s = <-titlebut => case s{ "exit" => if(!exiting){ if(opts.xkill) killkids(); else detachkids(); tkcmd("destroy ."); } exiting = 1; break; "task" => spawn task(tktop); * => tkclient->wmctl(tktop, s); } c := <-datatop.ctxt.kbd => tk->keyboard(datatop, c); p := <-datatop.ctxt.ptr => tk->pointer(datatop, *p); s := <-datactl => debdata->ctl(s); s := <-datatop.wreq or s = <-datatop.ctxt.ctl or s = <-datatitle => case s{ "task" => spawn debdata->wmctl(s); * => debdata->wmctl(s); } o := <-optchan => if(o != nil && checkopts(o)) opts = o; optchan = optdummy; p := <-pickchan => if(p < 0){ pickchan = pickdummy; break; } k := pickup(p); if(k != nil && k != kid){ kid = k; refresh(k); } s := <-m => case s { "open" => open(); "pickup" => if(pickchan == pickdummy){ pickchan = chan of int; spawn pickprog(pickchan); } "options" => if(optchan == optdummy){ optchan = chan of ref Options; spawn options(opts, optchan); } "step" => step(kid, KidStep); "over" => step(kid, KidOver); "out" => step(kid, KidOut); "stmt" => step(kid, KidStmt); "run" => step(kid, KidRun); "stop" => if(kid != nil) kid.prog.stop(); "killall" => killkids(); "kill" => killkid(kid); "detach" => detachkid(kid); "setbpt" => setbpt(); "look" => debsrc->search(debsrc->snarf()); "search" => s = dialog->getstring(context, tktop.image, "Search For"); if(s == ""){ tkcmd(".m.search.menu delete 2"); }else{ if(searchfor == "") tkcmd(".m.search.menu add command -command {send m research}"); tkcmd(".m.search.menu entryconfigure 2 -label '/"+s); debsrc->search(s); } searchfor = s; "research" => debsrc->search(searchfor); "stack" => if(debdata != nil) debdata->raisex(); * => if(str->prefix("open ", s)) debsrc->showstrsrc(s[len "open ":]); else if(str->prefix("seeprog ", s)) seekid(int s[len "seeprog ":]); else if(str->prefix("seebpt ", s)) seebpt(int s[len "seebpt ":]); } (k, s) := <-kidevent => case s{ "recv" => if(k.state == Running) k.state = Recv; "send" => if(k.state == Running) k.state = Send; "alt" => if(k.state == Running) k.state = Alt; "run" => if(k.state == Recv || k.state == Send || k.state == Alt) k.state = Running; "exited" => k.state = Exited; "interrupted" or "killed" => alert("Thread "+string k.prog.id+" "+s); k.state = Exited; * => if(str->prefix("new ", s)){ nk := newkid(int s[len "new ":]); if(opts.nrun) step(nk, KidRun); break; } if(str->prefix("load ", s)){ s = s[len "load ":]; if(s != nil && s[0] != '$') loaded(s); break; } if(str->prefix("child: ", s)) s = s[len "child: ":]; if(str->prefix("broken: ", s)) k.state = Broken; alert("Thread "+string k.prog.id+" "+s); } if(k == kid && k.state != Running) refresh(k); k = nil; (k, s) := <-kidack => if(k.state == Killing){ k.state = Killed; k.cmd <-= KidKill; k = nil; break; } if(k.state == Killed){ delkid(k); k = nil; break; } case s{ "" or "child: breakpoint" or "child: stopped" => k.state = Stopped; k.prog.unstop(); "prog broken" => k.state = Broken; * => if(!str->prefix("child: ", s)) alert("Debugger error "+status[k.state]+" "+string k.prog.id+" '"+s+"'"); } if(k == kid) refresh(k); if(k.pickup && opts.nrun){ k.pickup = 0; if(k.state == Stopped) step(k, KidRun); } k = nil; } } exitdb(); } task(top: ref Tk->Toplevel) { tkclient->wmctl(top, "task"); } open() { pattern := list of { "*.b (Limbo source files)", "* (All files)" }; file := selectfile->filename(context, tktop.image, "Open source file", pattern, opendir); if(file != nil) open1(file); } open1(file: string) { (opendir, nil) = str->splitr(file, "/"); if(opendir == "") opendir = "."; m := debsrc->loadsrc(file, 1); if(m == nil){ alert("Can't open "+file); return; } debsrc->showmodsrc(m, ref Src((file, 1, 0), (file, 1, 0))); kidstate(); if(opts.start == nil){ opts.start = file; opts.mod = m; } if(opts.dir == "") opts.dir = opendir; } options(oo: ref Options, r: chan of ref Options) { (t, titlebut) := tkclient->toplevel(context, nil, "Wmdeb Options", tkclient->OK); tkcmds(t, tkoptions); tabsctl := tabs->mktabs(t, ".opts", tkopttabs, oo.tabs); tkcmds(t, tkoptpack); o := ref *oo; if(o.start != nil) tk->cmd(t, ".modent insert end '"+o.start); args := ""; for(oa := o.args; oa != nil; oa = tl oa){ if(args == "") args = hd oa; else args += " " + hd oa; } tk->cmd(t, ".argent insert end '"+args); tk->cmd(t, ".wdent insert end '"+o.dir); if(o.xkill) tk->cmd(t, ".x.kill invoke"); else tk->cmd(t, ".x.detach invoke"); if(o.nrun) tk->cmd(t, ".new.run invoke"); else tk->cmd(t, ".new.block invoke"); if(o.xscroll) tk->cmd(t, ".line.scroll invoke"); else tk->cmd(t, ".line.wrap invoke"); if(o.remcr) tk->cmd(t, ".crlf.yes invoke"); else tk->cmd(t, ".crlf.no invoke"); tk->cmd(t, ".killkids configure -command 'send cmd kill"); tk->cmd(t, ".runkids configure -command 'send cmd run"); tkclient->onscreen(t, nil); tkclient->startinput(t, "ptr" :: "kbd" :: nil); out: for(;;){ tk->cmd(t, "update"); alt{ c := <-t.ctxt.kbd => tk->keyboard(t, c); m := <-t.ctxt.ptr => tk->pointer(t, *m); s := <-tabsctl => o.tabs = tabs->tabsctl(t, ".opts", tkopttabs, o.tabs, s); s := <-t.ctxt.ctl or s = <-t.wreq or s = <-titlebut => case s{ "exit" => r <-= nil; exit; "ok" => break out; } tkclient->wmctl(t, s); } } xscroll := o.xscroll; o.start = tk->cmd(t, ".modent get"); (nil, o.args) = sys->tokenize(tk->cmd(t, ".argent get"), " \t\n"); o.dir = tk->cmd(t, ".wdent get"); case tk->cmd(t, "variable new"){ "r" => o.nrun = 1; "b" => o.nrun = 0; } case tk->cmd(t, "variable exit"){ "k" => o.xkill = 1; "d" => o.xkill = 0; } case tk->cmd(t, "variable wrap"){ "s" => o.xscroll = 1; "w" => o.xscroll = 0; } case tk->cmd(t, "variable crlf"){ "y" => o.remcr = 1; "n" => o.remcr = 0; } if(o.xscroll != xscroll){ if(o.xscroll) tkcmd("pack .body.scx -side bottom -fill x"); else tkcmd("pack forget .body.scx"); tkcmd("pack .body -expand 1 -fill both; update"); } debsrc->reinit(o.xscroll, o.remcr); writeopts(o); r <-= o; } checkopts(o: ref Options): int { if(o.start != ""){ o.mod = debsrc->loadsrc(o.start, 1); if(o.mod == nil) o.start = ""; } return 1; } pickprog(c: chan of int) { (t, titlebut) := tkclient->toplevel(context, nil, "Wmdeb Thread List", 0); cmd := chan of string; tk->namechan(t, cmd, "cmd"); tkcmds(t, tkpicktab); tk->cmd(t, "update"); ids := addpickprogs(t); tkclient->onscreen(t, nil); tkclient->startinput(t, "ptr" :: "kbd" :: nil); for(;;){ tk->cmd(t, "update"); alt{ key := <-t.ctxt.kbd => tk->keyboard(t, key); m := <-t.ctxt.ptr => tk->pointer(t, *m); s := <-t.ctxt.ctl or s = <-t.wreq or s = <-titlebut => if(s == "exit"){ c <-= -1; exit; } tkclient->wmctl(t, s); s := <-cmd => case s{ "ok" => c <-= -1; exit; "prog" => sel := tk->cmd(t, ".progs.p curselection"); if(sel == "") break; pid := int tk->cmd(t, ".progs.p get "+sel); c <-= pid; "group" => sel := tk->cmd(t, ".progs.p curselection"); if(sel == "") break; nid := int sel; if(nid > len ids || nid < 0) break; (nil, gid) := ids[nid]; nid = len ids; for(i := 0; i < nid; i++){ (p, g) := ids[i]; if(g == gid) c <-= p; } } } } } addpickprogs(t: ref Tk->Toplevel): array of (int, int) { (d, n) := readdir->init("/prog", Readdir->NONE); if(n <= 0) return nil; a := array[n] of { * => (-1, -1) }; for(i := 0; i < n; i++){ (p, nil) := debug->prog(int d[i].name); if(p == nil) continue; (grp, nil, st, code) := debug->p.status(); if(grp < 0) continue; a[i] = (p.id, grp); tk->cmd(t, ".progs.p insert end '"+ sys->sprint("%4d %4d %8s %s", p.id, grp, st, code)); } return a; } step(k: ref Kid, cmd: int) { if(k == nil){ if(kids != nil){ alert("No current thread"); return; } k = spawnkid(opts); kid = k; if(k != nil) refresh(k); return; } case k.state{ Stopped => k.cmd <-= cmd; k.state = Running; if(k == kid) kidstate(); Running or Send or Recv or Alt or Exited or Broken => ; * => sys->print("bad debug step state %d\n", k.state); } } setbpt() { (m, pc) := debsrc->getsel(); if(m == nil) return; s := m.sym.pctosrc(pc); if(s == nil){ alert("No pc is appropriate"); return; } # if the breakpoint is already there, delete it for(bl := bpts; bl != nil; bl = tl bl){ b := hd bl; if(b.m == m && b.pc == pc){ bpts = delbpt(b, bpts); return; } } b := ref Bpt(bptid++, m, pc); bpts = b :: bpts; debsrc->attachdis(m); for(kl := kids; kl != nil; kl = tl kl){ k := hd kl; k.prog.setbpt(m.dis, pc); } # mark the breakpoint text tkcmd(m.tk+" tag add bpt "+string s.start.line+"."+string s.start.pos+" "+string s.stop.line+"."+string s.stop.pos); # add the kid to the breakpoint window me := ".bpt.v."+string b.id; tkcmd("label "+me+" -text "+string b.id); tkcmd("pack "+me+" -side top -fill x"); tkcmd("bind "+me+" <ButtonRelease-1> {send m seebpt "+string b.id+"}"); updatebpts(); } seebpt(bpt: int) { for(bl := bpts; bl != nil; bl = tl bl){ b := hd bl; if(b.id == bpt){ s := b.m.sym.pctosrc(b.pc); debsrc->showmodsrc(b.m, s); return; } } } delbpt(b: ref Bpt, bpts: list of ref Bpt): list of ref Bpt { if(bpts == nil) return nil; hb := hd bpts; tb := tl bpts; if(b == hb){ # remove mark from breakpoint text s := b.m.sym.pctosrc(b.pc); tkcmd(b.m.tk+" tag remove bpt "+string s.start.line+"."+string s.start.pos+" "+string s.stop.line+"."+string s.stop.pos); # remove the breakpoint window tkcmd("destroy .bpt.v."+string b.id); # remove from kids disablebpt(b); return tb; } return hb :: delbpt(b, tb); } disablebpt(b: ref Bpt) { for(kl := kids; kl != nil; kl = tl kl){ k := hd kl; k.prog.delbpt(b.m.dis, b.pc); } } updatebpts() { tkcmd("update"); tkcmd(".bpt.d configure -scrollregion {0 0 [.bpt.v cget -width] [.bpt.v cget -height]}"); } seekid(pid: int) { for(kl := kids; kl != nil; kl = tl kl){ k := hd kl; if(k.prog.id == pid){ kid = k; kid.stack.show(); refresh(kid); return; } } } delkid(k: ref Kid) { kids = rdelkid(k, kids); if(kid == k){ if(kids == nil){ kid = nil; kidstate(); }else{ kid = hd kids; refresh(kid); } } } rdelkid(k: ref Kid, kids: list of ref Kid): list of ref Kid { if(kids == nil) return nil; hk := hd kids; t := tl kids; if(k == hk){ # remove kid from display k.stack.delete(); tkcmd("destroy .prog.v."+string k.prog.id); updatekids(); return t; } return hk :: rdelkid(k, t); } updatekids() { tkcmd("update"); tkcmd(".prog.d configure -scrollregion {0 0 [.prog.v cget -width] [.prog.v cget -height]}"); } killkids() { for(kl := kids; kl != nil; kl = tl kl) killkid(hd kl); } killkid(k: ref Kid) { if(k.watch >= 0){ killpid(k.watch); k.watch = -1; } case k.state{ Exited or Broken or Stopped => k.cmd <-= KidKill; k.state = Killed; Running or Send or Recv or Alt or Killing => k.prog.kill(); k.state = Killing; * => sys->print("unknown state %d in killkid\n", k.state); } } freekids(): int { r := 0; for(kl := kids; kl != nil; kl = tl kl){ k := hd kl; if(k.state == Exited || k.state == Killing || k.state == Killed){ r ++; detachkid(k); } } return r; } detachkids() { for(kl := kids; kl != nil; kl = tl kl) detachkid(hd kl); } detachkid(k: ref Kid) { if(k == nil){ alert("No current thread"); return; } if(k.state == Exited){ killkid(k); return; } # kill off the debugger progs killpid(k.watch); killpid(k.run); err := k.prog.start(); if(err != "") alert("Detaching thread: "+err); delkid(k); } kidstate() { ts : array of string; if(kid == nil){ tkcmd(".Wm_t.title configure -text '"+title); if(debsrc->packed == nil){ tkcmds(tktop, searchoff); ts = tknobody; }else{ ts = tkloaded; tkcmds(tktop, searchon); } }else{ tkcmd(".Wm_t.title configure -text '"+title+" "+string kid.prog.id+" "+status[kid.state]); ts = tktools[kid.state]; tkcmds(tktop, searchon); } if(ts != toolstate){ toolstate = ts; tkcmds(tktop, ts); } } # # update the stack an src displays # to reflect the current state of k # refresh(k: ref Kid) { if(k.state == Killing || k.state == Killed){ kidstate(); return; } (s, err) := k.prog.stack(); if(s == nil && err == "") err = "No stack"; if(err != ""){ kidstate(); return; } for(i := 0; i < len s; i++){ debsrc->findmod(s[i].m); s[i].findsym(); } err = s[0].findsym(); src := s[0].src(); kidstate(); m := s[0].m; if(src == nil && len s > 1){ dis := s[0].m.dis(); if(len dis > 0 && dis[0] == '$'){ m = s[1].m; s[1].findsym(); src = s[1].src(); } } debsrc->showmodsrc(debsrc->findmod(m), src); k.stack.refresh(s); k.stack.show(); } pickup(pid: int): ref Kid { for(kl := kids; kl != nil; kl = tl kl) if((hd kl).prog.id == pid) return hd kl; k := newkid(pid); if(k == nil) return nil; k.cmd <-= KidGrab; k.state = Running; k.pickup = 1; if(kid == nil){ kid = k; refresh(kid); } return k; } loaded(s: string) { for(bl := bpts; bl != nil; bl = tl bl){ b := hd bl; debsrc->attachdis(b.m); if(s == b.m.dis){ for(kl := kids; kl != nil; kl = tl kl) (hd kl).prog.setbpt(s, b.pc); } } } Enofd: con "no free file descriptors\n"; newkid(pid: int): ref Kid { (p, err) := debug->prog(pid); if(err != ""){ n := len err - len Enofd; if(n >= 0 && err[n: ] == Enofd && freekids()){ (p, err) = debug->prog(pid); if(err == "") return mkkid(p); } alert("Can't pick up thread "+err); return nil; } return mkkid(p); } mkkid(p: ref Prog): ref Kid { for(bl := bpts; bl != nil; bl = tl bl){ b := hd bl; debsrc->attachdis(b.m); p.setbpt(b.m.dis, b.pc); } k := ref Kid(Stopped, p, -1, -1, 0, chan of int, Vars.create()); kids = k :: kids; c := chan of int; spawn kidslave(k, c); k.run = <- c; spawn kidwatch(k, c); k.watch = <-c; me := ".prog.v."+string p.id; tkcmd("label "+me+" -text "+string p.id); tkcmd("pack "+me+" -side top -fill x"); tkcmd("bind "+me+" <ButtonRelease-1> {send m seeprog "+string p.id+"}"); tkcmd(".prog.d configure -scrollregion {0 0 [.prog.v cget -width] [.prog.v cget -height]}"); return k; } spawnkid(o: ref Options): ref Kid { m := o.mod; if(m == nil){ alert("No module to run"); return nil; } if(!debsrc->attachdis(m)){ alert("Can't load Dis file "+m.dis); return nil; } (p, err) := debug->startprog(m.dis, o.dir, kidctxt, m.dis :: o.args); if(err != nil){ alert(m.dis+" is not a debuggable Dis command module: "+err); return nil; } return mkkid(p); } xlate := array[] of { KidStep => Debug->StepExp, KidStmt => Debug->StepStmt, KidOver => Debug->StepOver, KidOut => Debug->StepOut, }; kidslave(k: ref Kid, me: chan of int) { me <-= sys->pctl(0, nil); me = nil; for(;;){ c := <-k.cmd; case c{ KidGrab => err := k.prog.grab(); kidack <-= (k, err); KidStep or KidStmt or KidOver or KidOut => err := k.prog.step(xlate[c]); kidack <-= (k, err); KidKill => err := "kill "+k.prog.kill(); k.prog.kill(); # kill again to slay blocked progs kidack <-= (k, err); exit; KidRun => err := k.prog.cont(); kidack <-= (k, err); * => sys->print("kidslave: bad command %d\n", c); exit; } } } kidwatch(k: ref Kid, me: chan of int) { me <-= sys->pctl(0, nil); me = nil; for(;;) kidevent <-= (k, k.prog.event()); } alert(m: string) { dialog->prompt(context, tktop.image, "warning -fg yellow", "Debugger Alert", m, 0, "Dismiss"::nil); } tkcmd(cmd: string): string { s := tk->cmd(tktop, cmd); # if(len s != 0 && s[0] == '!') # sys->print("%s '%s'\n", s, cmd); return s; } sysname(): string { fd := sys->open("#c/sysname", sys->OREAD); if(fd == nil) return "Anon"; buf := array[128] of byte; n := sys->read(fd, buf, len buf); if(n < 0) return "Anon"; return string buf[:n]; } tkcmds(top: ref Tk->Toplevel, cmds: array of string) { for(i := 0; i < len cmds; i++) tk->cmd(top, cmds[i]); } exitdb() { fd := sys->open("#p/"+string dbpid+"/ctl", sys->OWRITE); if(fd != nil) sys->fprint(fd, "killgrp"); exit; } killpid(pid: int) { fd := sys->open("#p/"+string pid+"/ctl", sys->OWRITE); if(fd != nil) sys->fprint(fd, "kill"); } getuser(): string { fd := sys->open("/dev/user", Sys->OREAD); if(fd == nil) return ""; buf := array[128] of byte; n := sys->read(fd, buf, len buf); if(n < 0) return ""; return string buf[0:n]; } debconf(): string { return "/usr/" + getuser() + "/lib/deb"; } readopts(o: ref Options) { fd := sys->open(debconf(), Sys->OREAD); if(fd == nil) return; b := array[4] of byte; if(sys->read(fd, b, 4) != 4) return; o.nrun = int b[0]-'0'; o.xkill = int b[1]-'0'; o.xscroll = int b[2]-'0'; o.remcr = int b[3]-'0'; } writeopts(o: ref Options) { fd := sys->create(debconf(), Sys->OWRITE, 8r660); if(fd == nil) return; b := array[4] of byte; b[0] = byte (o.nrun+'0'); b[1] = byte (o.xkill+'0'); b[2] = byte (o.xscroll+'0'); b[3] = byte (o.remcr+'0'); sys->write(fd, b, 4); }