diff options
Diffstat (limited to 'appl/wm/deb.b')
| -rw-r--r-- | appl/wm/deb.b | 1444 |
1 files changed, 1444 insertions, 0 deletions
diff --git a/appl/wm/deb.b b/appl/wm/deb.b new file mode 100644 index 00000000..fa8208b0 --- /dev/null +++ b/appl/wm/deb.b @@ -0,0 +1,1444 @@ +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); +} |