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 buttonssearchoff := 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 dialogtkoptpack := 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 boxtkpicktab := 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");Lines 1–500 of 1444. Load more
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");