1implement WmDebugger; 2 3include "sys.m"; 4 sys: Sys; 5 stderr: ref Sys->FD; 6 7include "string.m"; 8 str: String; 9 10include "arg.m"; 11 arg: Arg; 12 13include "readdir.m"; 14 readdir: Readdir; 15 16include "draw.m"; 17 draw: Draw; 18 19include "tk.m"; 20 tk: Tk; 21 22include "tkclient.m"; 23 tkclient: Tkclient; 24 25include "dialog.m"; 26 dialog: Dialog; 27 28include "selectfile.m"; 29 selectfile: Selectfile; 30 31include "tabs.m"; 32 tabs: Tabs; 33 34include "debug.m"; 35 debug: Debug; 36 Prog, Exp, Module, Src, Sym: import debug; 37 38include "wmdeb.m"; 39 debdata: DebData; 40 Vars: import debdata; 41 debsrc: DebSrc; 42 opendir, Mod: import debsrc; 43 44WmDebugger: module 45{ 46 init: fn(ctxt: ref Draw->Context, argv: list of string); 47}; 48 49icondir : con "debug/"; 50 51tkconfig := array[] of { 52 "frame .m -relief raised -bd 1", 53 "frame .p -padx 2", 54 "frame .ctls -padx 2", 55 "frame .body", 56 57 # menu bar 58 "menubutton .m.file -text File -menu .m.file.menu", 59 "menubutton .m.search -text Search -menu .m.search.menu", 60 "button .m.stack -text Stack -command {send m stack}", 61 "pack .m.file .m.search .m.stack -side left", 62 63 # file menu 64 "menu .m.file.menu", 65 ".m.file.menu add command -label Open... -command {send m open}", 66 ".m.file.menu add command -label Thread... -command {send m pickup}", 67 ".m.file.menu add command -label Options... -command {send m options}", 68 ".m.file.menu add separator", 69 70 # search menu 71 "menu .m.search.menu", 72 ".m.search.menu add command -state disabled"+ 73 " -label Look -command {send m look}", 74 ".m.search.menu add command -state disabled"+ 75 " -label {Search For} -command {send m search}", 76 77 # program control 78 "image create bitmap Detach -file "+icondir+ 79 "detach.bit -maskfile "+icondir+"detach.mask", 80 "image create bitmap Kill -file "+icondir+ 81 "kill.bit -maskfile "+icondir+"kill.mask", 82 "image create bitmap Run -file "+icondir+ 83 "run.bit -maskfile "+icondir+"run.mask", 84 "image create bitmap Stop -file "+icondir+ 85 "stop.bit -maskfile "+icondir+"stop.mask", 86 "image create bitmap Bpt -file "+icondir+ 87 "break.bit -maskfile "+icondir+"break.mask", 88 "image create bitmap Stepop -file "+icondir+ 89 "stepop.bit -maskfile "+icondir+"stepop.mask", 90 "image create bitmap Stepin -file "+icondir+ 91 "stepin.bit -maskfile "+icondir+"stepin.mask", 92 "image create bitmap Stepout -file "+icondir+ 93 "stepout.bit -maskfile "+icondir+"stepout.mask", 94 "image create bitmap Stepover -file "+icondir+ 95 "stepover.bit -maskfile "+icondir+"stepover.mask", 96 "button .p.kill -image Kill -command {send m killall}"+ 97 " -state disabled -relief sunken", 98 "bind .p.kill <Enter> +{.p.status configure -text {kill current process}}", 99 "bind .p.kill <Leave> +{.p.status configure -text {}}", 100 "button .p.detach -image Detach -command {send m detach}"+ 101 " -state disabled -relief sunken", 102 "bind .p.detach <Enter> +{.p.status configure -text {stop debugging current process}}", 103 "bind .p.detach <Leave> +{.p.status configure -text {}}", 104 "button .p.run -image Run -command {send m run}"+ 105 " -state disabled -relief sunken", 106 "bind .p.run <Enter> +{.p.status configure -text {run to breakpoint}}", 107 "bind .p.run <Leave> +{.p.status configure -text {}}", 108 "button .p.step -image Stepop -command {send m step}"+ 109 " -state disabled -relief sunken", 110 "bind .p.step <Enter> +{.p.status configure -text {step one operation}}", 111 "bind .p.step <Leave> +{.p.status configure -text {}}", 112 "button .p.stmt -image Stepin -command {send m stmt}"+ 113 " -state disabled -relief sunken", 114 "bind .p.stmt <Enter> +{.p.status configure -text {step one statement}}", 115 "bind .p.stmt <Leave> +{.p.status configure -text {}}", 116 "button .p.over -image Stepover -command {send m over}"+ 117 " -state disabled -relief sunken", 118 "bind .p.over <Enter> +{.p.status configure -text {step over calls}}", 119 "bind .p.over <Leave> +{.p.status configure -text {}}", 120 "button .p.out -image Stepout -command {send m out}"+ 121 " -state disabled -relief sunken", 122 "bind .p.out <Enter> +{.p.status configure -text {step out of fn}}", 123 "bind .p.out <Leave> +{.p.status configure -text {}}", 124 "button .p.bpt -image Bpt -command {send m setbpt}"+ 125 " -state disabled -relief sunken", 126 "bind .p.bpt <Enter> +{.p.status configure -text {set/clear breakpoint}}", 127 "bind .p.bpt <Leave> +{.p.status configure -text {}}", 128 "frame .p.steps", 129 "label .p.status -anchor w", 130 "pack .p.step .p.stmt .p.over .p.out -in .p.steps -side left -fill y", 131 "pack .p.kill .p.detach .p.run .p.steps .p.bpt -side left -padx 5 -fill y", 132 "pack .p.status -side left -expand 1 -fill x", 133 134 # progs 135 "frame .prog", 136 "label .prog.l -text Threads", 137 "canvas .prog.d -height 1 -width 1 -relief sunken -bd 2", 138 "frame .prog.v", 139 ".prog.d create window 0 0 -window .prog.v -anchor nw", 140 "pack .prog.l -side top -anchor w", 141 "pack .prog.d -side left -fill both -expand 1", 142 143 # breakpoints 144 "frame .bpt", 145 "label .bpt.l -text Break", 146 "canvas .bpt.d -height 1 -width 1 -relief sunken -bd 2", 147 "frame .bpt.v", 148 ".bpt.d create window 0 0 -window .bpt.v -anchor nw", 149 "pack .bpt.l -side top -anchor w", 150 "pack .bpt.d -side left -fill both -expand 1", 151 152 "pack .prog .bpt -side top -fill both -expand 1 -in .ctls", 153 154 # test body 155 "frame .body.ft -bd 1 -relief sunken -width 60w -height 20h", 156 "scrollbar .body.scy", 157 "pack .body.scy -side right -fill y", 158 159 "pack .body.ft -side top -expand 1 -fill both", 160 "pack propagate .body.ft 0", 161 162 "pack .m .p -side top -fill x", 163 "pack .ctls -side left -fill y", 164 165 "scrollbar .body.scx -orient horizontal", 166 "pack .body.scx -side bottom -fill x", 167 168 "pack .body -expand 1 -fill both", 169 170 "pack propagate . 0", 171 172 "raise .; update; cursor -default" 173}; 174 175# commands for disabling or enabling buttons 176searchoff := array[] of { 177 ".m.search.menu entryconfigure 0 -state disabled", 178 ".m.search.menu entryconfigure 1 -state disabled", 179 ".m.search.menu entryconfigure 2 -state disabled", 180}; 181searchon := array[] of { 182 ".m.search.menu entryconfigure 0 -state normal", 183 ".m.search.menu entryconfigure 1 -state normal", 184 ".m.search.menu entryconfigure 2 -state normal", 185}; 186tkstopped := array[] of { 187 ".p.bpt configure -state normal -relief raised", 188 ".p.detach configure -state normal -relief raised", 189 ".p.kill configure -state normal -relief raised", 190 ".p.out configure -state normal -relief raised", 191 ".p.over configure -state normal -relief raised", 192 ".p.run configure -state normal -relief raised -image Run -command {send m run}", 193 ".p.step configure -state normal -relief raised", 194 ".p.stmt configure -state normal -relief raised", 195}; 196tkrunning := array[] of { 197 ".p.bpt configure -state normal -relief raised", 198 ".p.detach configure -state normal -relief raised", 199 ".p.kill configure -state normal -relief raised", 200 ".p.out configure -state disabled -relief sunken", 201 ".p.over configure -state disabled -relief sunken", 202 ".p.run configure -state normal -relief raised -image Stop -command {send m stop}", 203 ".p.step configure -state disabled -relief sunken", 204 ".p.stmt configure -state disabled -relief sunken", 205}; 206tkexited := array[] of { 207 ".p.bpt configure -state normal -relief raised", 208 ".p.detach configure -state normal -relief raised", 209 ".p.kill configure -state normal -relief raised", 210 ".p.out configure -state disabled -relief sunken", 211 ".p.over configure -state disabled -relief sunken", 212 ".p.run configure -state disabled -relief sunken -image Run -command {send m run}", 213 ".p.step configure -state disabled -relief sunken", 214 ".p.stmt configure -state disabled -relief sunken", 215 ".p.stop configure -state disabled -relief sunken", 216}; 217tkloaded := array[] of { 218 ".p.bpt configure -state normal -relief raised", 219 ".p.detach configure -state disabled -relief sunken", 220 ".p.kill configure -state disabled -relief sunken", 221 ".p.out configure -state disabled -relief sunken", 222 ".p.over configure -state disabled -relief sunken", 223 ".p.run configure -state normal -relief raised -image Run -command {send m run}", 224 ".p.step configure -state disabled -relief sunken", 225 ".p.stmt configure -state disabled -relief sunken", 226}; 227tknobody := array[] of { 228 ".p.bpt configure -state disabled -relief sunken", 229 ".p.detach configure -state disabled -relief sunken", 230 ".p.kill configure -state disabled -relief sunken", 231 ".p.out configure -state disabled -relief sunken", 232 ".p.over configure -state disabled -relief sunken", 233 ".p.run configure -state disabled -relief sunken -image Run -command {send m run}", 234 ".p.step configure -state disabled -relief sunken", 235 ".p.stmt configure -state disabled -relief sunken", 236}; 237 238#tk option dialog 239tkoptpack := array[] of { 240 "frame .buts", 241 242 "pack .opts -side left -padx 10 -pady 5", 243}; 244 245tkoptions := array[] of { 246 # general options 247 "frame .gen", 248 "frame .mod", 249 "label .modlab -text 'Source of executable module", 250 "entry .modent", 251 "pack .modlab -in .mod -anchor w", 252 "pack .modent -in .mod -fill x", 253 254 "frame .arg", 255 "label .arglab -text 'Program Arguments", 256 "entry .argent -width 300", 257 "pack .arglab -in .arg -anchor w", 258 "pack .argent -in .arg -fill x", 259 260 "frame .wd", 261 "label .wdlab -text 'Working Directory", 262 "entry .wdent", 263 "pack .wdlab -in .wd -anchor w", 264 "pack .wdent -in .wd -fill x", 265 266 "pack .mod .arg .wd -fill x -anchor w -pady 10 -in .gen", 267 268 # thread control options 269 "frame .prog", 270 "frame .new", 271 "radiobutton .new.run -variable new -value r -text 'Run new threads", 272 "radiobutton .new.block -variable new -value b -text 'Block new threads", 273 "pack .new.block .new.run -anchor w", 274 "frame .x", 275 "radiobutton .x.kill -variable exit -value k -text 'Kill threads on exit", 276 "radiobutton .x.detach -variable exit -value d -text 'Detach threads on exit", 277 "pack .x.kill .x.detach -anchor w", 278 "pack .new .x -expand 1 -anchor w -in .prog", 279 280 # layout options 281 "frame .layout", 282 "frame .line", 283 "radiobutton .line.wrap -variable wrap -value w -text 'Wrap lines", 284 "radiobutton .line.scroll -variable wrap -value s -text 'Horizontal scroll", 285 "pack .line.wrap .line.scroll -anchor w", 286 "frame .crlf", 287 "radiobutton .crlf.no -variable crlf -value n -text 'CR/LF as is", 288 "radiobutton .crlf.yes -variable crlf -value y -text 'CR/LF -> LF", 289 "pack .crlf.no .crlf.yes -anchor w", 290 "pack .line .crlf -expand 1 -anchor w -in .layout", 291}; 292 293tkopttabs := array[] of { 294 ("General", ".gen"), 295 ("Thread", ".prog"), 296 ("Layout", ".layout"), 297}; 298 299# prog listing dialog box 300tkpicktab := array[] of { 301 "frame .progs", 302 "scrollbar .progs.s -command '.progs.p yview", 303 "listbox .progs.p -width 35w -yscrollcommand '.progs.s set", 304 "bind .progs.p <Double-Button-1> 'send cmd prog", 305 "pack .progs.s -side right -fill y", 306 "pack .progs.p -fill both -expand 1", 307 308 "frame .buts", 309 "button .buts.prog -text {Add Thread} -command 'send cmd prog", 310 "button .buts.grp -text {Add Group} -command 'send cmd group", 311 "pack .buts.prog .buts.grp -expand 1 -side left -fill x -padx 4 -pady 4", 312 313 "pack .progs -fill both -expand 1", 314 "pack .buts -fill x", 315 "pack propagate . 0", 316}; 317 318Bpt: adt 319{ 320 id: int; 321 m: ref Mod; 322 pc: int; 323}; 324 325Recv, Send, Alt, Running, Stopped, Exited, Broken, Killing, Killed: con iota; 326status := array[] of 327{ 328 Running => "Running", 329 Recv => "Receive", 330 Send => "Send", 331 Alt => "Alt", 332 Stopped => "Stopped", 333 Exited => "Exited", 334 Broken => "Broken", 335 Killing => "Killed", 336 Killed => "Killed", 337}; 338 339tktools : array of array of string; 340toolstate : array of string; 341 342KidGrab, KidStep, KidStmt, KidOver, KidOut, KidKill, KidRun: con iota; 343Kid: adt 344{ 345 state: int; 346 prog: ref Prog; 347 watch: int; # pid of watching prog 348 run: int; # pid of stepping prog 349 pickup: int; # picking up this kid? 350 cmd: chan of int; 351 stack: ref Vars; 352}; 353 354Options: adt 355{ 356 start: string; # src of module to start 357 mod: ref Mod; # module to start 358 wm: int; # program is a wm program? 359 path: array of string;# search path for .src and .sbl 360 args: list of string; # argument for starting a kid 361 dir: string; # . for kid 362 tabs: int; # options to show 363 nrun: int; # run new kids? 364 xkill: int; # kill kids on exit? 365 xscroll: int; # horizontal scrolling 366 remcr: int; # CR/LF -> LF 367}; 368 369tktop: ref Tk->Toplevel; 370kids: list of ref Kid; 371kid: ref Kid; 372kidctxt: ref Draw->Context; 373kidack: chan of (ref Kid, string); 374kidevent: chan of (ref Kid, string); 375bpts: list of ref Bpt; 376bptid:= 1; 377title: string; 378runok := 0; 379context: ref Draw->Context; 380opts: ref Options; 381dbpid: int; 382searchfor: string; 383initsrc: string; 384 385badmodule(p: string) 386{ 387 sys->fprint(sys->fildes(2), "deb: cannot load %s: %r\n", p); 388 raise "fail:bad module"; 389} 390 391init(ctxt: ref Draw->Context, argv: list of string) 392{ 393 sys = load Sys Sys->PATH; 394 if (ctxt == nil) { 395 sys->fprint(sys->fildes(2), "deb: no window context\n"); 396 raise "fail:bad context"; 397 } 398 draw = load Draw Draw->PATH; 399 tk = load Tk Tk->PATH; 400 tkclient = load Tkclient Tkclient->PATH; 401 if(tkclient == nil) 402 badmodule(Tkclient->PATH); 403 selectfile = load Selectfile Selectfile->PATH; 404 if(selectfile == nil) 405 badmodule(Selectfile->PATH); 406 dialog = load Dialog Dialog->PATH; 407 if(dialog == nil) 408 badmodule(Dialog->PATH); 409 tabs = load Tabs Tabs->PATH; 410 if(tabs == nil) 411 badmodule(Tabs->PATH); 412 str = load String String->PATH; 413 if(str == nil) 414 badmodule(String->PATH); 415 readdir = load Readdir Readdir->PATH; 416 if(readdir == nil) 417 badmodule(Readdir->PATH); 418 debug = load Debug Debug->PATH; 419 if(debug == nil) 420 badmodule(Debug->PATH); 421 debdata = load DebData DebData->PATH; 422 if(debdata == nil) 423 badmodule(DebData->PATH); 424 debsrc = load DebSrc DebSrc->PATH; 425 if(debsrc == nil) 426 badmodule(DebSrc->PATH); 427 arg = load Arg Arg->PATH; 428 if(arg == nil) 429 badmodule(Arg->PATH); 430 dbpid = sys->pctl(Sys->NEWPGRP, nil); 431 opts = ref Options; 432 opts.tabs = 0; 433 opts.nrun = 0; 434 opts.xkill = 1; 435 opts.xscroll = 0; 436 opts.remcr = 0; 437 readopts(opts); 438 sysnam := sysname(); 439 context = ctxt; 440 441 grabpids: list of int; 442 arg->init(argv); 443 arg->setusage("wmdeb [-p pid]"); 444 while((opt := arg->opt()) != 0){ 445 case opt { 446 'f' => 447 initsrc = arg->earg(); 448 'p' => 449 grabpids = int arg->earg() :: grabpids; 450 * => 451 arg->usage(); 452 } 453 } 454 for(argv = arg->argv(); argv != nil; argv = tl argv) 455 grabpids = int hd argv :: grabpids; 456 arg = nil; 457 458 pickdummy := chan of int; 459 pickchan := pickdummy; 460 optdummy := chan of ref Options; 461 optchan := optdummy; 462 463 tktools = array[] of { 464 Running => tkrunning, 465 Recv => tkrunning, 466 Send => tkrunning, 467 Alt => tkrunning, 468 Stopped => tkstopped, 469 Exited => tkexited, 470 Broken => tkexited, 471 Killing => tkexited, 472 Killed => tkexited, 473 }; 474 475 476 tkclient->init(); 477 selectfile->init(); 478 dialog->init(); 479 tabs->init(); 480 481 title = sysnam+":Wmdeb"; 482 titlebut := chan of string; 483 (tktop, titlebut) = tkclient->toplevel(context, nil, title, Tkclient->Appl); 484 tkcmd("cursor -bitmap cursor.wait"); 485 486 debug->init(); 487 kidctxt = ctxt; 488 489 stderr = sys->fildes(2); 490 491 debsrc->init(context, tktop, tkclient, selectfile, dialog, str, debug, opts.xscroll, opts.remcr); 492 (datatop, datactl, datatitle) := debdata->init(context, nil, debsrc, str, debug); 493 494 m := chan of string; 495 tk->namechan(tktop, m, "m"); 496 toolstate = tknobody; 497 tkcmds(tktop, tkconfig); 498 if(!opts.xscroll){ 499 tkcmd("pack forget .body.scx"); 500 tkcmd("pack .body -expand 1 -fill both; update"); 501 } 502 503 tkcmd("cursor -default"); 504 tkclient->onscreen(tktop, nil); 505 tkclient->startinput(tktop, "kbd" :: "ptr" :: nil); 506 507 kids = nil; 508 kid = nil; 509 kidack = chan of (ref Kid, string); 510 kidevent = chan of (ref Kid, string); 511 512 # pick up a src file, a kid? 513 if(initsrc != nil) 514 open1(initsrc); 515 else if(grabpids != nil) 516 for(; grabpids != nil; grabpids = tl grabpids) 517 pickup(hd grabpids); 518 519 for(exiting := 0; !exiting || kids != nil; ){ 520 tkcmd("update"); 521 alt { 522 c := <-tktop.ctxt.kbd => 523 tk->keyboard(tktop, c); 524 p := <-tktop.ctxt.ptr => 525 tk->pointer(tktop, *p); 526 s := <-tktop.ctxt.ctl or 527 s = <-tktop.wreq or 528 s = <-titlebut => 529 case s{ 530 "exit" => 531 if(!exiting){ 532 if(opts.xkill) 533 killkids(); 534 else 535 detachkids(); 536 tkcmd("destroy ."); 537 } 538 exiting = 1; 539 break; 540 "task" => 541 spawn task(tktop); 542 * => 543 tkclient->wmctl(tktop, s); 544 } 545 c := <-datatop.ctxt.kbd => 546 tk->keyboard(datatop, c); 547 p := <-datatop.ctxt.ptr => 548 tk->pointer(datatop, *p); 549 s := <-datactl => 550 debdata->ctl(s); 551 s := <-datatop.wreq or 552 s = <-datatop.ctxt.ctl or 553 s = <-datatitle => 554 case s{ 555 "task" => 556 spawn debdata->wmctl(s); 557 * => 558 debdata->wmctl(s); 559 } 560 o := <-optchan => 561 if(o != nil && checkopts(o)) 562 opts = o; 563 optchan = optdummy; 564 p := <-pickchan => 565 if(p < 0){ 566 pickchan = pickdummy; 567 break; 568 } 569 k := pickup(p); 570 if(k != nil && k != kid){ 571 kid = k; 572 refresh(k); 573 } 574 s := <-m => 575 case s { 576 "open" => 577 open(); 578 "pickup" => 579 if(pickchan == pickdummy){ 580 pickchan = chan of int; 581 spawn pickprog(pickchan); 582 } 583 "options" => 584 if(optchan == optdummy){ 585 optchan = chan of ref Options; 586 spawn options(opts, optchan); 587 } 588 "step" => 589 step(kid, KidStep); 590 "over" => 591 step(kid, KidOver); 592 "out" => 593 step(kid, KidOut); 594 "stmt" => 595 step(kid, KidStmt); 596 "run" => 597 step(kid, KidRun); 598 "stop" => 599 if(kid != nil) 600 kid.prog.stop(); 601 "killall" => 602 killkids(); 603 "kill" => 604 killkid(kid); 605 "detach" => 606 detachkid(kid); 607 "setbpt" => 608 setbpt(); 609 "look" => 610 debsrc->search(debsrc->snarf()); 611 "search" => 612 s = dialog->getstring(context, tktop.image, "Search For"); 613 if(s == ""){ 614 tkcmd(".m.search.menu delete 2"); 615 }else{ 616 if(searchfor == "") 617 tkcmd(".m.search.menu add command -command {send m research}"); 618 tkcmd(".m.search.menu entryconfigure 2 -label '/"+s); 619 debsrc->search(s); 620 } 621 searchfor = s; 622 "research" => 623 debsrc->search(searchfor); 624 "stack" => 625 if(debdata != nil) 626 debdata->raisex(); 627 * => 628 if(str->prefix("open ", s)) 629 debsrc->showstrsrc(s[len "open ":]); 630 else if(str->prefix("seeprog ", s)) 631 seekid(int s[len "seeprog ":]); 632 else if(str->prefix("seebpt ", s)) 633 seebpt(int s[len "seebpt ":]); 634 } 635 (k, s) := <-kidevent => 636 case s{ 637 "recv" => 638 if(k.state == Running) 639 k.state = Recv; 640 "send" => 641 if(k.state == Running) 642 k.state = Send; 643 "alt" => 644 if(k.state == Running) 645 k.state = Alt; 646 "run" => 647 if(k.state == Recv || k.state == Send || k.state == Alt) 648 k.state = Running; 649 "exited" => 650 k.state = Exited; 651 "interrupted" or 652 "killed" => 653 alert("Thread "+string k.prog.id+" "+s); 654 k.state = Exited; 655 * => 656 if(str->prefix("new ", s)){ 657 nk := newkid(int s[len "new ":]); 658 if(opts.nrun) 659 step(nk, KidRun); 660 break; 661 } 662 if(str->prefix("load ", s)){ 663 s = s[len "load ":]; 664 if(s != nil && s[0] != '$') 665 loaded(s); 666 break; 667 } 668 if(str->prefix("child: ", s)) 669 s = s[len "child: ":]; 670 671 if(str->prefix("broken: ", s)) 672 k.state = Broken; 673 alert("Thread "+string k.prog.id+" "+s); 674 } 675 if(k == kid && k.state != Running) 676 refresh(k); 677 k = nil; 678 (k, s) := <-kidack => 679 if(k.state == Killing){ 680 k.state = Killed; 681 k.cmd <-= KidKill; 682 k = nil; 683 break; 684 } 685 if(k.state == Killed){ 686 delkid(k); 687 k = nil; 688 break; 689 } 690 case s{ 691 "" or "child: breakpoint" or "child: stopped" => 692 k.state = Stopped; 693 k.prog.unstop(); 694 "prog broken" => 695 k.state = Broken; 696 * => 697 if(!str->prefix("child: ", s)) 698 alert("Debugger error "+status[k.state]+" "+string k.prog.id+" '"+s+"'"); 699 } 700 if(k == kid) 701 refresh(k); 702 if(k.pickup && opts.nrun){ 703 k.pickup = 0; 704 if(k.state == Stopped) 705 step(k, KidRun); 706 } 707 k = nil; 708 } 709 } 710 exitdb(); 711} 712 713task(top: ref Tk->Toplevel) 714{ 715 tkclient->wmctl(top, "task"); 716} 717 718open() 719{ 720 pattern := list of { 721 "*.b (Limbo source files)", 722 "* (All files)" 723 }; 724 725 file := selectfile->filename(context, tktop.image, "Open source file", pattern, opendir); 726 if(file != nil) 727 open1(file); 728} 729 730open1(file: string) 731{ 732 (opendir, nil) = str->splitr(file, "/"); 733 if(opendir == "") 734 opendir = "."; 735 m := debsrc->loadsrc(file, 1); 736 if(m == nil){ 737 alert("Can't open "+file); 738 return; 739 } 740 debsrc->showmodsrc(m, ref Src((file, 1, 0), (file, 1, 0))); 741 kidstate(); 742 if(opts.start == nil){ 743 opts.start = file; 744 opts.mod = m; 745 } 746 if(opts.dir == "") 747 opts.dir = opendir; 748} 749 750options(oo: ref Options, r: chan of ref Options) 751{ 752 (t, titlebut) := tkclient->toplevel(context, nil, "Wmdeb Options", tkclient->OK); 753 754 tkcmds(t, tkoptions); 755 tabsctl := tabs->mktabs(t, ".opts", tkopttabs, oo.tabs); 756 tkcmds(t, tkoptpack); 757 758 o := ref *oo; 759 if(o.start != nil) 760 tk->cmd(t, ".modent insert end '"+o.start); 761 args := ""; 762 for(oa := o.args; oa != nil; oa = tl oa){ 763 if(args == "") 764 args = hd oa; 765 else 766 args += " " + hd oa; 767 } 768 tk->cmd(t, ".argent insert end '"+args); 769 tk->cmd(t, ".wdent insert end '"+o.dir); 770 if(o.xkill) 771 tk->cmd(t, ".x.kill invoke"); 772 else 773 tk->cmd(t, ".x.detach invoke"); 774 if(o.nrun) 775 tk->cmd(t, ".new.run invoke"); 776 else 777 tk->cmd(t, ".new.block invoke"); 778 if(o.xscroll) 779 tk->cmd(t, ".line.scroll invoke"); 780 else 781 tk->cmd(t, ".line.wrap invoke"); 782 if(o.remcr) 783 tk->cmd(t, ".crlf.yes invoke"); 784 else 785 tk->cmd(t, ".crlf.no invoke"); 786 787 tk->cmd(t, ".killkids configure -command 'send cmd kill"); 788 tk->cmd(t, ".runkids configure -command 'send cmd run"); 789 tkclient->onscreen(t, nil); 790 tkclient->startinput(t, "ptr" :: "kbd" :: nil); 791 792out: for(;;){ 793 tk->cmd(t, "update"); 794 alt{ 795 c := <-t.ctxt.kbd => 796 tk->keyboard(t, c); 797 m := <-t.ctxt.ptr => 798 tk->pointer(t, *m); 799 s := <-tabsctl => 800 o.tabs = tabs->tabsctl(t, ".opts", tkopttabs, o.tabs, s); 801 s := <-t.ctxt.ctl or 802 s = <-t.wreq or 803 s = <-titlebut => 804 case s{ 805 "exit" => 806 r <-= nil; 807 exit; 808 "ok" => 809 break out; 810 } 811 tkclient->wmctl(t, s); 812 } 813 } 814 xscroll := o.xscroll; 815 o.start = tk->cmd(t, ".modent get"); 816 (nil, o.args) = sys->tokenize(tk->cmd(t, ".argent get"), " \t\n"); 817 o.dir = tk->cmd(t, ".wdent get"); 818 case tk->cmd(t, "variable new"){ 819 "r" => o.nrun = 1; 820 "b" => o.nrun = 0; 821 } 822 case tk->cmd(t, "variable exit"){ 823 "k" => o.xkill = 1; 824 "d" => o.xkill = 0; 825 } 826 case tk->cmd(t, "variable wrap"){ 827 "s" => o.xscroll = 1; 828 "w" => o.xscroll = 0; 829 } 830 case tk->cmd(t, "variable crlf"){ 831 "y" => o.remcr = 1; 832 "n" => o.remcr = 0; 833 } 834 if(o.xscroll != xscroll){ 835 if(o.xscroll) 836 tkcmd("pack .body.scx -side bottom -fill x"); 837 else 838 tkcmd("pack forget .body.scx"); 839 tkcmd("pack .body -expand 1 -fill both; update"); 840 } 841 debsrc->reinit(o.xscroll, o.remcr); 842 writeopts(o); 843 r <-= o; 844} 845 846checkopts(o: ref Options): int 847{ 848 if(o.start != ""){ 849 o.mod = debsrc->loadsrc(o.start, 1); 850 if(o.mod == nil) 851 o.start = ""; 852 } 853 return 1; 854} 855 856pickprog(c: chan of int) 857{ 858 (t, titlebut) := tkclient->toplevel(context, nil, "Wmdeb Thread List", 0); 859 cmd := chan of string; 860 tk->namechan(t, cmd, "cmd"); 861 862 tkcmds(t, tkpicktab); 863 tk->cmd(t, "update"); 864 ids := addpickprogs(t); 865 tkclient->onscreen(t, nil); 866 tkclient->startinput(t, "ptr" :: "kbd" :: nil); 867 868 for(;;){ 869 tk->cmd(t, "update"); 870 alt{ 871 key := <-t.ctxt.kbd => 872 tk->keyboard(t, key); 873 m := <-t.ctxt.ptr => 874 tk->pointer(t, *m); 875 s := <-t.ctxt.ctl or 876 s = <-t.wreq or 877 s = <-titlebut => 878 if(s == "exit"){ 879 c <-= -1; 880 exit; 881 } 882 tkclient->wmctl(t, s); 883 s := <-cmd => 884 case s{ 885 "ok" => 886 c <-= -1; 887 exit; 888 "prog" => 889 sel := tk->cmd(t, ".progs.p curselection"); 890 if(sel == "") 891 break; 892 pid := int tk->cmd(t, ".progs.p get "+sel); 893 c <-= pid; 894 "group" => 895 sel := tk->cmd(t, ".progs.p curselection"); 896 if(sel == "") 897 break; 898 nid := int sel; 899 if(nid > len ids || nid < 0) 900 break; 901 (nil, gid) := ids[nid]; 902 nid = len ids; 903 for(i := 0; i < nid; i++){ 904 (p, g) := ids[i]; 905 if(g == gid) 906 c <-= p; 907 } 908 } 909 } 910 } 911} 912 913addpickprogs(t: ref Tk->Toplevel): array of (int, int) 914{ 915 (d, n) := readdir->init("/prog", Readdir->NONE); 916 if(n <= 0) 917 return nil; 918 a := array[n] of { * => (-1, -1) }; 919 for(i := 0; i < n; i++){ 920 (p, nil) := debug->prog(int d[i].name); 921 if(p == nil) 922 continue; 923 (grp, nil, st, code) := debug->p.status(); 924 if(grp < 0) 925 continue; 926 a[i] = (p.id, grp); 927 tk->cmd(t, ".progs.p insert end '"+ 928 sys->sprint("%4d %4d %8s %s", p.id, grp, st, code)); 929 } 930 return a; 931} 932 933step(k: ref Kid, cmd: int) 934{ 935 if(k == nil){ 936 if(kids != nil){ 937 alert("No current thread"); 938 return; 939 } 940 k = spawnkid(opts); 941 kid = k; 942 if(k != nil) 943 refresh(k); 944 return; 945 } 946 case k.state{ 947 Stopped => 948 k.cmd <-= cmd; 949 k.state = Running; 950 if(k == kid) 951 kidstate(); 952 Running or Send or Recv or Alt or Exited or Broken => 953 ; 954 * => 955 sys->print("bad debug step state %d\n", k.state); 956 } 957} 958 959setbpt() 960{ 961 (m, pc) := debsrc->getsel(); 962 if(m == nil) 963 return; 964 s := m.sym.pctosrc(pc); 965 if(s == nil){ 966 alert("No pc is appropriate"); 967 return; 968 } 969 970 # if the breakpoint is already there, delete it 971 for(bl := bpts; bl != nil; bl = tl bl){ 972 b := hd bl; 973 if(b.m == m && b.pc == pc){ 974 bpts = delbpt(b, bpts); 975 return; 976 } 977 } 978 979 b := ref Bpt(bptid++, m, pc); 980 bpts = b :: bpts; 981 debsrc->attachdis(m); 982 for(kl := kids; kl != nil; kl = tl kl){ 983 k := hd kl; 984 k.prog.setbpt(m.dis, pc); 985 } 986 987 # mark the breakpoint text 988 tkcmd(m.tk+" tag add bpt "+string s.start.line+"."+string s.start.pos+" "+string s.stop.line+"."+string s.stop.pos); 989 990 # add the kid to the breakpoint window 991 me := ".bpt.v."+string b.id; 992 tkcmd("label "+me+" -text "+string b.id); 993 tkcmd("pack "+me+" -side top -fill x"); 994 tkcmd("bind "+me+" <ButtonRelease-1> {send m seebpt "+string b.id+"}"); 995 updatebpts(); 996} 997 998seebpt(bpt: int) 999{ 1000 for(bl := bpts; bl != nil; bl = tl bl){ 1001 b := hd bl; 1002 if(b.id == bpt){ 1003 s := b.m.sym.pctosrc(b.pc); 1004 debsrc->showmodsrc(b.m, s); 1005 return; 1006 } 1007 } 1008} 1009 1010delbpt(b: ref Bpt, bpts: list of ref Bpt): list of ref Bpt 1011{ 1012 if(bpts == nil) 1013 return nil; 1014 hb := hd bpts; 1015 tb := tl bpts; 1016 if(b == hb){ 1017 # remove mark from breakpoint text 1018 s := b.m.sym.pctosrc(b.pc); 1019 tkcmd(b.m.tk+" tag remove bpt "+string s.start.line+"."+string s.start.pos+" "+string s.stop.line+"."+string s.stop.pos); 1020 1021 # remove the breakpoint window 1022 tkcmd("destroy .bpt.v."+string b.id); 1023 1024 # remove from kids 1025 disablebpt(b); 1026 return tb; 1027 } 1028 return hb :: delbpt(b, tb); 1029 1030} 1031 1032disablebpt(b: ref Bpt) 1033{ 1034 for(kl := kids; kl != nil; kl = tl kl){ 1035 k := hd kl; 1036 k.prog.delbpt(b.m.dis, b.pc); 1037 } 1038} 1039 1040updatebpts() 1041{ 1042tkcmd("update"); 1043 tkcmd(".bpt.d configure -scrollregion {0 0 [.bpt.v cget -width] [.bpt.v cget -height]}"); 1044} 1045 1046seekid(pid: int) 1047{ 1048 for(kl := kids; kl != nil; kl = tl kl){ 1049 k := hd kl; 1050 if(k.prog.id == pid){ 1051 kid = k; 1052 kid.stack.show(); 1053 refresh(kid); 1054 return; 1055 } 1056 } 1057} 1058 1059delkid(k: ref Kid) 1060{ 1061 kids = rdelkid(k, kids); 1062 if(kid == k){ 1063 if(kids == nil){ 1064 kid = nil; 1065 kidstate(); 1066 }else{ 1067 kid = hd kids; 1068 refresh(kid); 1069 } 1070 } 1071} 1072 1073rdelkid(k: ref Kid, kids: list of ref Kid): list of ref Kid 1074{ 1075 if(kids == nil) 1076 return nil; 1077 hk := hd kids; 1078 t := tl kids; 1079 if(k == hk){ 1080 # remove kid from display 1081 k.stack.delete(); 1082 tkcmd("destroy .prog.v."+string k.prog.id); 1083 updatekids(); 1084 return t; 1085 } 1086 return hk :: rdelkid(k, t); 1087} 1088 1089updatekids() 1090{ 1091tkcmd("update"); 1092 tkcmd(".prog.d configure -scrollregion {0 0 [.prog.v cget -width] [.prog.v cget -height]}"); 1093} 1094 1095killkids() 1096{ 1097 for(kl := kids; kl != nil; kl = tl kl) 1098 killkid(hd kl); 1099} 1100 1101killkid(k: ref Kid) 1102{ 1103 if(k.watch >= 0){ 1104 killpid(k.watch); 1105 k.watch = -1; 1106 } 1107 case k.state{ 1108 Exited or Broken or Stopped => 1109 k.cmd <-= KidKill; 1110 k.state = Killed; 1111 Running or Send or Recv or Alt or Killing => 1112 k.prog.kill(); 1113 k.state = Killing; 1114 * => 1115 sys->print("unknown state %d in killkid\n", k.state); 1116 } 1117} 1118 1119freekids(): int 1120{ 1121 r := 0; 1122 for(kl := kids; kl != nil; kl = tl kl){ 1123 k := hd kl; 1124 if(k.state == Exited || k.state == Killing || k.state == Killed){ 1125 r ++; 1126 detachkid(k); 1127 } 1128 } 1129 return r; 1130} 1131 1132detachkids() 1133{ 1134 for(kl := kids; kl != nil; kl = tl kl) 1135 detachkid(hd kl); 1136} 1137 1138detachkid(k: ref Kid) 1139{ 1140 if(k == nil){ 1141 alert("No current thread"); 1142 return; 1143 } 1144 if(k.state == Exited){ 1145 killkid(k); 1146 return; 1147 } 1148 1149 # kill off the debugger progs 1150 killpid(k.watch); 1151 killpid(k.run); 1152 err := k.prog.start(); 1153 if(err != "") 1154 alert("Detaching thread: "+err); 1155 1156 delkid(k); 1157} 1158 1159kidstate() 1160{ 1161 ts : array of string; 1162 if(kid == nil){ 1163 tkcmd(".Wm_t.title configure -text '"+title); 1164 if(debsrc->packed == nil){ 1165 tkcmds(tktop, searchoff); 1166 ts = tknobody; 1167 }else{ 1168 ts = tkloaded; 1169 tkcmds(tktop, searchon); 1170 } 1171 }else{ 1172 tkcmd(".Wm_t.title configure -text '"+title+" "+string kid.prog.id+" "+status[kid.state]); 1173 ts = tktools[kid.state]; 1174 tkcmds(tktop, searchon); 1175 } 1176 if(ts != toolstate){ 1177 toolstate = ts; 1178 tkcmds(tktop, ts); 1179 } 1180} 1181 1182# 1183# update the stack an src displays 1184# to reflect the current state of k 1185# 1186refresh(k: ref Kid) 1187{ 1188 if(k.state == Killing || k.state == Killed){ 1189 kidstate(); 1190 return; 1191 } 1192 (s, err) := k.prog.stack(); 1193 if(s == nil && err == "") 1194 err = "No stack"; 1195 if(err != ""){ 1196 kidstate(); 1197 return; 1198 } 1199 for(i := 0; i < len s; i++){ 1200 debsrc->findmod(s[i].m); 1201 s[i].findsym(); 1202 } 1203 err = s[0].findsym(); 1204 src := s[0].src(); 1205 kidstate(); 1206 m := s[0].m; 1207 if(src == nil && len s > 1){ 1208 dis := s[0].m.dis(); 1209 if(len dis > 0 && dis[0] == '$'){ 1210 m = s[1].m; 1211 s[1].findsym(); 1212 src = s[1].src(); 1213 } 1214 } 1215 debsrc->showmodsrc(debsrc->findmod(m), src); 1216 k.stack.refresh(s); 1217 k.stack.show(); 1218} 1219 1220pickup(pid: int): ref Kid 1221{ 1222 for(kl := kids; kl != nil; kl = tl kl) 1223 if((hd kl).prog.id == pid) 1224 return hd kl; 1225 k := newkid(pid); 1226 if(k == nil) 1227 return nil; 1228 k.cmd <-= KidGrab; 1229 k.state = Running; 1230 k.pickup = 1; 1231 if(kid == nil){ 1232 kid = k; 1233 refresh(kid); 1234 } 1235 return k; 1236} 1237 1238loaded(s: string) 1239{ 1240 for(bl := bpts; bl != nil; bl = tl bl){ 1241 b := hd bl; 1242 debsrc->attachdis(b.m); 1243 if(s == b.m.dis){ 1244 for(kl := kids; kl != nil; kl = tl kl) 1245 (hd kl).prog.setbpt(s, b.pc); 1246 } 1247 } 1248} 1249 1250Enofd: con "no free file descriptors\n"; 1251 1252newkid(pid: int): ref Kid 1253{ 1254 (p, err) := debug->prog(pid); 1255 if(err != ""){ 1256 n := len err - len Enofd; 1257 if(n >= 0 && err[n: ] == Enofd && freekids()){ 1258 (p, err) = debug->prog(pid); 1259 if(err == "") 1260 return mkkid(p); 1261 } 1262 alert("Can't pick up thread "+err); 1263 return nil; 1264 } 1265 return mkkid(p); 1266} 1267 1268mkkid(p: ref Prog): ref Kid 1269{ 1270 for(bl := bpts; bl != nil; bl = tl bl){ 1271 b := hd bl; 1272 debsrc->attachdis(b.m); 1273 p.setbpt(b.m.dis, b.pc); 1274 } 1275 k := ref Kid(Stopped, p, -1, -1, 0, chan of int, Vars.create()); 1276 kids = k :: kids; 1277 c := chan of int; 1278 spawn kidslave(k, c); 1279 k.run = <- c; 1280 spawn kidwatch(k, c); 1281 k.watch = <-c; 1282 me := ".prog.v."+string p.id; 1283 tkcmd("label "+me+" -text "+string p.id); 1284 tkcmd("pack "+me+" -side top -fill x"); 1285 tkcmd("bind "+me+" <ButtonRelease-1> {send m seeprog "+string p.id+"}"); 1286 tkcmd(".prog.d configure -scrollregion {0 0 [.prog.v cget -width] [.prog.v cget -height]}"); 1287 return k; 1288} 1289 1290spawnkid(o: ref Options): ref Kid 1291{ 1292 m := o.mod; 1293 if(m == nil){ 1294 alert("No module to run"); 1295 return nil; 1296 } 1297 1298 if(!debsrc->attachdis(m)){ 1299 alert("Can't load Dis file "+m.dis); 1300 return nil; 1301 } 1302 1303 (p, err) := debug->startprog(m.dis, o.dir, kidctxt, m.dis :: o.args); 1304 if(err != nil){ 1305 alert(m.dis+" is not a debuggable Dis command module: "+err); 1306 return nil; 1307 } 1308 1309 return mkkid(p); 1310} 1311 1312xlate := array[] of { 1313 KidStep => Debug->StepExp, 1314 KidStmt => Debug->StepStmt, 1315 KidOver => Debug->StepOver, 1316 KidOut => Debug->StepOut, 1317}; 1318 1319kidslave(k: ref Kid, me: chan of int) 1320{ 1321 me <-= sys->pctl(0, nil); 1322 me = nil; 1323 for(;;){ 1324 c := <-k.cmd; 1325 case c{ 1326 KidGrab => 1327 err := k.prog.grab(); 1328 kidack <-= (k, err); 1329 KidStep or KidStmt or KidOver or KidOut => 1330 err := k.prog.step(xlate[c]); 1331 kidack <-= (k, err); 1332 KidKill => 1333 err := "kill "+k.prog.kill(); 1334 k.prog.kill(); # kill again to slay blocked progs 1335 kidack <-= (k, err); 1336 exit; 1337 KidRun => 1338 err := k.prog.cont(); 1339 kidack <-= (k, err); 1340 * => 1341 sys->print("kidslave: bad command %d\n", c); 1342 exit; 1343 } 1344 } 1345} 1346 1347kidwatch(k: ref Kid, me: chan of int) 1348{ 1349 me <-= sys->pctl(0, nil); 1350 me = nil; 1351 for(;;) 1352 kidevent <-= (k, k.prog.event()); 1353} 1354 1355alert(m: string) 1356{ 1357 dialog->prompt(context, tktop.image, "warning -fg yellow", 1358 "Debugger Alert", m, 0, "Dismiss"::nil); 1359} 1360 1361tkcmd(cmd: string): string 1362{ 1363 s := tk->cmd(tktop, cmd); 1364# if(len s != 0 && s[0] == '!') 1365# sys->print("%s '%s'\n", s, cmd); 1366 return s; 1367} 1368 1369sysname(): string 1370{ 1371 fd := sys->open("#c/sysname", sys->OREAD); 1372 if(fd == nil) 1373 return "Anon"; 1374 buf := array[128] of byte; 1375 n := sys->read(fd, buf, len buf); 1376 if(n < 0) 1377 return "Anon"; 1378 return string buf[:n]; 1379} 1380 1381tkcmds(top: ref Tk->Toplevel, cmds: array of string) 1382{ 1383 for(i := 0; i < len cmds; i++) 1384 tk->cmd(top, cmds[i]); 1385} 1386 1387exitdb() 1388{ 1389 fd := sys->open("#p/"+string dbpid+"/ctl", sys->OWRITE); 1390 if(fd != nil) 1391 sys->fprint(fd, "killgrp"); 1392 exit; 1393} 1394 1395killpid(pid: int) 1396{ 1397 fd := sys->open("#p/"+string pid+"/ctl", sys->OWRITE); 1398 if(fd != nil) 1399 sys->fprint(fd, "kill"); 1400} 1401 1402getuser(): string 1403{ 1404 fd := sys->open("/dev/user", Sys->OREAD); 1405 if(fd == nil) 1406 return ""; 1407 buf := array[128] of byte; 1408 n := sys->read(fd, buf, len buf); 1409 if(n < 0) 1410 return ""; 1411 return string buf[0:n]; 1412} 1413 1414debconf(): string 1415{ 1416 return "/usr/" + getuser() + "/lib/deb"; 1417} 1418 1419readopts(o: ref Options) 1420{ 1421 fd := sys->open(debconf(), Sys->OREAD); 1422 if(fd == nil) 1423 return; 1424 b := array[4] of byte; 1425 if(sys->read(fd, b, 4) != 4) 1426 return; 1427 o.nrun = int b[0]-'0'; 1428 o.xkill = int b[1]-'0'; 1429 o.xscroll = int b[2]-'0'; 1430 o.remcr = int b[3]-'0'; 1431} 1432 1433writeopts(o: ref Options) 1434{ 1435 fd := sys->create(debconf(), Sys->OWRITE, 8r660); 1436 if(fd == nil) 1437 return; 1438 b := array[4] of byte; 1439 b[0] = byte (o.nrun+'0'); 1440 b[1] = byte (o.xkill+'0'); 1441 b[2] = byte (o.xscroll+'0'); 1442 b[3] = byte (o.remcr+'0'); 1443 sys->write(fd, b, 4); 1444} 1445