Commit | Line | Data |
---|---|---|
754e5da2 SG |
1 | /* TK interface routines. |
2 | Copyright 1994 Free Software Foundation, Inc. | |
3 | ||
4 | This file is part of GDB. | |
5 | ||
6 | This program is free software; you can redistribute it and/or modify | |
7 | it under the terms of the GNU General Public License as published by | |
8 | the Free Software Foundation; either version 2 of the License, or | |
9 | (at your option) any later version. | |
10 | ||
11 | This program is distributed in the hope that it will be useful, | |
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | GNU General Public License for more details. | |
15 | ||
16 | You should have received a copy of the GNU General Public License | |
17 | along with this program; if not, write to the Free Software | |
18 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | ||
20 | #include "defs.h" | |
21 | #include "symtab.h" | |
22 | #include "inferior.h" | |
23 | #include "command.h" | |
24 | #include "bfd.h" | |
25 | #include "symfile.h" | |
26 | #include "objfiles.h" | |
27 | #include "target.h" | |
754e5da2 SG |
28 | #include <tcl.h> |
29 | #include <tk.h> | |
cd2df226 SG |
30 | #include <varargs.h> |
31 | #include <signal.h> | |
32 | #include <fcntl.h> | |
8532893d | 33 | #include <unistd.h> |
754e5da2 SG |
34 | |
35 | /* Non-zero means that we're doing the gdbtk interface. */ | |
36 | int gdbtk = 0; | |
37 | ||
38 | /* Non-zero means we are reloading breakpoints, etc from the | |
39 | Gdbtk kernel, and we should suppress various messages */ | |
40 | static int gdbtk_reloading = 0; | |
41 | ||
42 | /* Handle for TCL interpreter */ | |
43 | static Tcl_Interp *interp = NULL; | |
44 | ||
45 | /* Handle for TK main window */ | |
46 | static Tk_Window mainWindow = NULL; | |
47 | ||
479f0f18 SG |
48 | static int x_fd; /* X network socket */ |
49 | ||
754e5da2 SG |
50 | static void |
51 | null_routine(arg) | |
52 | int arg; | |
53 | { | |
54 | } | |
55 | ||
56 | \f | |
57 | /* This routine redirects the output of fputs_unfiltered so that | |
58 | the user can see what's going on in his debugger window. */ | |
59 | ||
8532893d SG |
60 | static char holdbuf[200]; |
61 | static char *holdbufp = holdbuf; | |
62 | static int holdfree = sizeof (holdbuf); | |
63 | ||
754e5da2 | 64 | static void |
8532893d | 65 | flush_holdbuf () |
754e5da2 | 66 | { |
8532893d SG |
67 | if (holdbufp == holdbuf) |
68 | return; | |
69 | ||
70 | Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", holdbuf, "}", NULL); | |
71 | holdbufp = holdbuf; | |
72 | holdfree = sizeof (holdbuf); | |
754e5da2 SG |
73 | } |
74 | ||
75 | static void | |
76 | gdbtk_flush (stream) | |
77 | FILE *stream; | |
78 | { | |
8532893d SG |
79 | flush_holdbuf (); |
80 | ||
754e5da2 SG |
81 | Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL); |
82 | } | |
83 | ||
8532893d SG |
84 | static void |
85 | gdbtk_fputs (ptr) | |
86 | const char *ptr; | |
87 | { | |
88 | int len; | |
89 | ||
90 | len = strlen (ptr) + 1; | |
91 | ||
92 | if (len > holdfree) | |
93 | { | |
94 | flush_holdbuf (); | |
95 | ||
96 | if (len > sizeof (holdbuf)) | |
97 | { | |
98 | Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", ptr, "}", NULL); | |
99 | return; | |
100 | } | |
101 | } | |
102 | ||
103 | strncpy (holdbufp, ptr, len); | |
104 | holdbufp += len - 1; | |
105 | holdfree -= len - 1; | |
106 | } | |
107 | ||
754e5da2 SG |
108 | static int |
109 | gdbtk_query (args) | |
110 | va_list args; | |
111 | { | |
112 | char *query; | |
113 | char buf[200]; | |
114 | long val; | |
115 | ||
116 | query = va_arg (args, char *); | |
117 | ||
118 | vsprintf(buf, query, args); | |
119 | Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL); | |
120 | ||
121 | val = atol (interp->result); | |
122 | return val; | |
123 | } | |
124 | \f | |
637b1661 | 125 | #if 0 |
754e5da2 SG |
126 | static char * |
127 | full_filename(symtab) | |
128 | struct symtab *symtab; | |
129 | { | |
130 | int pathlen; | |
131 | char *filename; | |
132 | ||
133 | if (!symtab) | |
134 | return NULL; | |
135 | ||
136 | if (symtab->fullname) | |
137 | return savestring(symtab->fullname, strlen(symtab->fullname)); | |
138 | ||
139 | if (symtab->filename[0] == '/') | |
140 | return savestring(symtab->filename, strlen(symtab->filename)); | |
141 | ||
142 | if (symtab->dirname) | |
143 | pathlen = strlen(symtab->dirname); | |
144 | else | |
145 | pathlen = 0; | |
146 | if (symtab->filename) | |
147 | pathlen += strlen(symtab->filename); | |
148 | ||
149 | filename = xmalloc(pathlen+1); | |
150 | ||
151 | if (symtab->dirname) | |
152 | strcpy(filename, symtab->dirname); | |
153 | else | |
154 | *filename = '\000'; | |
155 | if (symtab->filename) | |
156 | strcat(filename, symtab->filename); | |
157 | ||
158 | return filename; | |
159 | } | |
637b1661 | 160 | #endif |
754e5da2 SG |
161 | \f |
162 | static void | |
163 | breakpoint_notify(b, action) | |
164 | struct breakpoint *b; | |
165 | const char *action; | |
166 | { | |
167 | struct symbol *sym; | |
8532893d | 168 | char bpnum[50], line[50], pc[50]; |
754e5da2 SG |
169 | struct symtab_and_line sal; |
170 | char *filename; | |
171 | int v; | |
172 | ||
173 | if (b->type != bp_breakpoint) | |
174 | return; | |
175 | ||
176 | sal = find_pc_line (b->address, 0); | |
177 | ||
637b1661 | 178 | filename = symtab_to_filename (sal.symtab); |
754e5da2 SG |
179 | |
180 | sprintf (bpnum, "%d", b->number); | |
181 | sprintf (line, "%d", sal.line); | |
8532893d | 182 | sprintf (pc, "0x%x", b->address); |
754e5da2 SG |
183 | |
184 | v = Tcl_VarEval (interp, | |
185 | "gdbtk_tcl_breakpoint ", | |
186 | action, | |
187 | " ", bpnum, | |
188 | " ", filename, | |
189 | " ", line, | |
8532893d | 190 | " ", pc, |
754e5da2 SG |
191 | NULL); |
192 | ||
193 | if (v != TCL_OK) | |
194 | { | |
195 | gdbtk_fputs (interp->result); | |
196 | gdbtk_fputs ("\n"); | |
197 | } | |
754e5da2 SG |
198 | } |
199 | ||
200 | static void | |
201 | gdbtk_create_breakpoint(b) | |
202 | struct breakpoint *b; | |
203 | { | |
204 | breakpoint_notify(b, "create"); | |
205 | } | |
206 | ||
207 | static void | |
208 | gdbtk_delete_breakpoint(b) | |
209 | struct breakpoint *b; | |
210 | { | |
211 | breakpoint_notify(b, "delete"); | |
212 | } | |
213 | ||
214 | static void | |
215 | gdbtk_enable_breakpoint(b) | |
216 | struct breakpoint *b; | |
217 | { | |
218 | breakpoint_notify(b, "enable"); | |
219 | } | |
220 | ||
221 | static void | |
222 | gdbtk_disable_breakpoint(b) | |
223 | struct breakpoint *b; | |
224 | { | |
225 | breakpoint_notify(b, "disable"); | |
226 | } | |
227 | \f | |
228 | /* This implements the TCL command `gdb_loc', which returns a list consisting | |
229 | of the source and line number associated with the current pc. */ | |
230 | ||
231 | static int | |
232 | gdb_loc (clientData, interp, argc, argv) | |
233 | ClientData clientData; | |
234 | Tcl_Interp *interp; | |
235 | int argc; | |
236 | char *argv[]; | |
237 | { | |
238 | char *filename; | |
239 | char buf[100]; | |
240 | struct symtab_and_line sal; | |
241 | char *funcname; | |
8532893d | 242 | CORE_ADDR pc; |
754e5da2 SG |
243 | |
244 | if (argc == 1) | |
245 | { | |
1dfc8dfb | 246 | pc = selected_frame ? selected_frame->pc : stop_pc; |
754e5da2 SG |
247 | sal = find_pc_line (pc, 0); |
248 | } | |
249 | else if (argc == 2) | |
250 | { | |
754e5da2 | 251 | struct symtabs_and_lines sals; |
8532893d | 252 | int nelts; |
754e5da2 SG |
253 | |
254 | sals = decode_line_spec (argv[1], 1); | |
255 | ||
8532893d SG |
256 | nelts = sals.nelts; |
257 | sal = sals.sals[0]; | |
258 | free (sals.sals); | |
259 | ||
754e5da2 SG |
260 | if (sals.nelts != 1) |
261 | { | |
262 | Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC); | |
754e5da2 SG |
263 | return TCL_ERROR; |
264 | } | |
265 | ||
8532893d | 266 | pc = sal.pc; |
754e5da2 SG |
267 | } |
268 | else | |
269 | { | |
270 | Tcl_SetResult (interp, "wrong # args", TCL_STATIC); | |
271 | return TCL_ERROR; | |
272 | } | |
273 | ||
754e5da2 SG |
274 | if (sal.symtab) |
275 | Tcl_AppendElement (interp, sal.symtab->filename); | |
276 | else | |
277 | Tcl_AppendElement (interp, ""); | |
8532893d SG |
278 | |
279 | find_pc_partial_function (pc, &funcname, NULL, NULL); | |
754e5da2 | 280 | Tcl_AppendElement (interp, funcname); |
8532893d | 281 | |
637b1661 | 282 | filename = symtab_to_filename (sal.symtab); |
754e5da2 | 283 | Tcl_AppendElement (interp, filename); |
8532893d SG |
284 | |
285 | sprintf (buf, "%d", sal.line); | |
754e5da2 SG |
286 | Tcl_AppendElement (interp, buf); /* line number */ |
287 | ||
8532893d SG |
288 | sprintf (buf, "0x%x", pc); |
289 | Tcl_AppendElement (interp, buf); /* PC */ | |
290 | ||
754e5da2 SG |
291 | return TCL_OK; |
292 | } | |
293 | \f | |
5b21fb68 SG |
294 | /* This implements the TCL command `gdb_sourcelines', which returns a list of |
295 | all of the lines containing executable code for the specified source file | |
296 | (ie: lines where you can put breakpoints). */ | |
297 | ||
298 | static int | |
299 | gdb_sourcelines (clientData, interp, argc, argv) | |
300 | ClientData clientData; | |
301 | Tcl_Interp *interp; | |
302 | int argc; | |
303 | char *argv[]; | |
304 | { | |
305 | struct symtab *symtab; | |
306 | struct linetable_entry *le; | |
307 | int nlines; | |
308 | char buf[100]; | |
309 | ||
310 | if (argc != 2) | |
311 | { | |
312 | Tcl_SetResult (interp, "wrong # args", TCL_STATIC); | |
313 | return TCL_ERROR; | |
314 | } | |
315 | ||
316 | symtab = lookup_symtab (argv[1]); | |
317 | ||
318 | if (!symtab) | |
319 | { | |
320 | Tcl_SetResult (interp, "No such file", TCL_STATIC); | |
321 | return TCL_ERROR; | |
322 | } | |
323 | ||
324 | /* If there's no linetable, or no entries, then we are done. */ | |
325 | ||
326 | if (!symtab->linetable | |
327 | || symtab->linetable->nitems == 0) | |
328 | { | |
329 | Tcl_AppendElement (interp, ""); | |
330 | return TCL_OK; | |
331 | } | |
332 | ||
333 | le = symtab->linetable->item; | |
334 | nlines = symtab->linetable->nitems; | |
335 | ||
336 | for (;nlines > 0; nlines--, le++) | |
337 | { | |
338 | /* If the pc of this line is the same as the pc of the next line, then | |
339 | just skip it. */ | |
340 | if (nlines > 1 | |
341 | && le->pc == (le + 1)->pc) | |
342 | continue; | |
343 | ||
344 | sprintf (buf, "%d", le->line); | |
345 | Tcl_AppendElement (interp, buf); | |
346 | } | |
347 | ||
348 | return TCL_OK; | |
349 | } | |
350 | \f | |
351 | /* This implements the TCL command `gdb_regnames', which returns a list of | |
352 | all of the register names. */ | |
353 | ||
354 | static int | |
355 | gdb_regnames (clientData, interp, argc, argv) | |
356 | ClientData clientData; | |
357 | Tcl_Interp *interp; | |
358 | int argc; | |
359 | char *argv[]; | |
360 | { | |
361 | int i; | |
362 | ||
363 | if (argc != 1) | |
364 | { | |
365 | Tcl_SetResult (interp, "wrong # args", TCL_STATIC); | |
366 | return TCL_ERROR; | |
367 | } | |
368 | ||
369 | for (i = 0; i < NUM_REGS; i++) | |
370 | Tcl_AppendElement (interp, reg_names[i]); | |
371 | ||
372 | return TCL_OK; | |
373 | } | |
374 | \f | |
754e5da2 SG |
375 | static int |
376 | gdb_cmd_stub (cmd) | |
377 | char *cmd; | |
378 | { | |
379 | execute_command (cmd, 1); | |
380 | ||
381 | return 1; /* Indicate success */ | |
382 | } | |
383 | ||
384 | /* This implements the TCL command `gdb_cmd', which sends it's argument into | |
385 | the GDB command scanner. */ | |
386 | ||
387 | static int | |
388 | gdb_cmd (clientData, interp, argc, argv) | |
389 | ClientData clientData; | |
390 | Tcl_Interp *interp; | |
391 | int argc; | |
392 | char *argv[]; | |
393 | { | |
394 | int val; | |
395 | struct cleanup *old_chain; | |
396 | ||
397 | if (argc != 2) | |
398 | { | |
399 | Tcl_SetResult (interp, "wrong # args", TCL_STATIC); | |
400 | return TCL_ERROR; | |
401 | } | |
402 | ||
403 | old_chain = make_cleanup (null_routine, 0); | |
404 | ||
405 | val = catch_errors (gdb_cmd_stub, argv[1], "", RETURN_MASK_ERROR); | |
406 | ||
479f0f18 SG |
407 | /* In case of an error, we may need to force the GUI into idle mode because |
408 | gdbtk_call_command may have bombed out while in the command routine. */ | |
409 | ||
410 | if (val == 0) | |
411 | Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL); | |
412 | ||
754e5da2 SG |
413 | bpstat_do_actions (&stop_bpstat); |
414 | do_cleanups (old_chain); | |
415 | ||
8532893d SG |
416 | /* Drain all buffered command output */ |
417 | ||
418 | gdb_flush (gdb_stderr); | |
419 | gdb_flush (gdb_stdout); | |
420 | ||
754e5da2 SG |
421 | /* We could base the return value on val, but that would require most users |
422 | to use catch. Since GDB errors are already being handled elsewhere, I | |
423 | see no reason to pass them up to the caller. */ | |
424 | ||
425 | return TCL_OK; | |
426 | } | |
427 | ||
428 | static int | |
429 | gdb_listfiles (clientData, interp, argc, argv) | |
430 | ClientData clientData; | |
431 | Tcl_Interp *interp; | |
432 | int argc; | |
433 | char *argv[]; | |
434 | { | |
435 | int val; | |
436 | struct objfile *objfile; | |
437 | struct partial_symtab *psymtab; | |
438 | ||
439 | ALL_PSYMTABS (objfile, psymtab) | |
440 | Tcl_AppendElement (interp, psymtab->filename); | |
441 | ||
442 | return TCL_OK; | |
443 | } | |
479f0f18 SG |
444 | |
445 | static int | |
446 | gdb_stop (clientData, interp, argc, argv) | |
447 | ClientData clientData; | |
448 | Tcl_Interp *interp; | |
449 | int argc; | |
450 | char *argv[]; | |
451 | { | |
6c27841f | 452 | target_stop (); |
479f0f18 SG |
453 | } |
454 | ||
754e5da2 SG |
455 | \f |
456 | static void | |
457 | tk_command (cmd, from_tty) | |
458 | char *cmd; | |
459 | int from_tty; | |
460 | { | |
461 | Tcl_VarEval (interp, cmd, NULL); | |
462 | ||
463 | gdbtk_fputs (interp->result); | |
464 | gdbtk_fputs ("\n"); | |
465 | } | |
466 | ||
467 | static void | |
468 | cleanup_init (ignored) | |
469 | int ignored; | |
470 | { | |
471 | if (mainWindow != NULL) | |
472 | Tk_DestroyWindow (mainWindow); | |
473 | mainWindow = NULL; | |
474 | ||
475 | if (interp != NULL) | |
476 | Tcl_DeleteInterp (interp); | |
477 | interp = NULL; | |
478 | } | |
479 | ||
637b1661 SG |
480 | /* Come here during long calculations to check for GUI events. Usually invoked |
481 | via the QUIT macro. */ | |
482 | ||
483 | static void | |
484 | gdbtk_interactive () | |
485 | { | |
486 | /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */ | |
487 | } | |
488 | ||
479f0f18 SG |
489 | /* Come here when there is activity on the X file descriptor. */ |
490 | ||
491 | static void | |
492 | x_event (signo) | |
493 | int signo; | |
494 | { | |
495 | /* Process pending events */ | |
496 | ||
497 | while (Tk_DoOneEvent (TK_DONT_WAIT|TK_ALL_EVENTS) != 0); | |
498 | } | |
499 | ||
500 | static int | |
501 | gdbtk_wait (pid, ourstatus) | |
502 | int pid; | |
503 | struct target_waitstatus *ourstatus; | |
504 | { | |
505 | signal (SIGIO, x_event); | |
506 | ||
507 | pid = target_wait (pid, ourstatus); | |
508 | ||
509 | signal (SIGIO, SIG_IGN); | |
510 | ||
511 | return pid; | |
512 | } | |
513 | ||
514 | /* This is called from execute_command, and provides a wrapper around | |
515 | various command routines in a place where both protocol messages and | |
516 | user input both flow through. Mostly this is used for indicating whether | |
517 | the target process is running or not. | |
518 | */ | |
519 | ||
520 | static void | |
521 | gdbtk_call_command (cmdblk, arg, from_tty) | |
522 | struct cmd_list_element *cmdblk; | |
523 | char *arg; | |
524 | int from_tty; | |
525 | { | |
526 | if (cmdblk->class == class_run) | |
527 | { | |
528 | Tcl_VarEval (interp, "gdbtk_tcl_busy", NULL); | |
529 | (*cmdblk->function.cfunc)(arg, from_tty); | |
530 | Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL); | |
531 | } | |
532 | else | |
533 | (*cmdblk->function.cfunc)(arg, from_tty); | |
534 | } | |
535 | ||
754e5da2 SG |
536 | static void |
537 | gdbtk_init () | |
538 | { | |
539 | struct cleanup *old_chain; | |
540 | char *gdbtk_filename; | |
479f0f18 | 541 | int i; |
754e5da2 SG |
542 | |
543 | old_chain = make_cleanup (cleanup_init, 0); | |
544 | ||
545 | /* First init tcl and tk. */ | |
546 | ||
547 | interp = Tcl_CreateInterp (); | |
548 | ||
549 | if (!interp) | |
550 | error ("Tcl_CreateInterp failed"); | |
551 | ||
552 | mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb"); | |
553 | ||
554 | if (!mainWindow) | |
555 | return; /* DISPLAY probably not set */ | |
556 | ||
557 | if (Tcl_Init(interp) != TCL_OK) | |
558 | error ("Tcl_Init failed: %s", interp->result); | |
559 | ||
560 | if (Tk_Init(interp) != TCL_OK) | |
561 | error ("Tk_Init failed: %s", interp->result); | |
562 | ||
563 | Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL); | |
564 | Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL); | |
5b21fb68 SG |
565 | Tcl_CreateCommand (interp, "gdb_sourcelines", gdb_sourcelines, NULL, NULL); |
566 | Tcl_CreateCommand (interp, "gdb_regnames", gdb_regnames, NULL, NULL); | |
754e5da2 | 567 | Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL); |
479f0f18 | 568 | Tcl_CreateCommand (interp, "gdb_stop", gdb_stop, NULL, NULL); |
754e5da2 SG |
569 | |
570 | gdbtk_filename = getenv ("GDBTK_FILENAME"); | |
8532893d SG |
571 | if (!gdbtk_filename) |
572 | if (access ("gdbtk.tcl", R_OK) == 0) | |
573 | gdbtk_filename = "gdbtk.tcl"; | |
574 | else | |
575 | gdbtk_filename = GDBTK_FILENAME; | |
576 | ||
577 | if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK) | |
578 | error ("Failure reading %s: %s", gdbtk_filename, interp->result); | |
754e5da2 | 579 | |
cd2df226 | 580 | /* Get the file descriptor for the X server */ |
479f0f18 | 581 | |
cd2df226 | 582 | x_fd = ConnectionNumber (Tk_Display (mainWindow)); |
479f0f18 SG |
583 | |
584 | /* Setup for I/O interrupts */ | |
585 | ||
586 | signal (SIGIO, SIG_IGN); | |
587 | ||
588 | i = fcntl (x_fd, F_GETFL, 0); | |
589 | fcntl (x_fd, F_SETFL, i|FASYNC); | |
590 | fcntl (x_fd, F_SETOWN, getpid()); | |
591 | ||
754e5da2 SG |
592 | command_loop_hook = Tk_MainLoop; |
593 | fputs_unfiltered_hook = gdbtk_fputs; | |
594 | print_frame_info_listing_hook = null_routine; | |
595 | query_hook = gdbtk_query; | |
596 | flush_hook = gdbtk_flush; | |
597 | create_breakpoint_hook = gdbtk_create_breakpoint; | |
598 | delete_breakpoint_hook = gdbtk_delete_breakpoint; | |
599 | enable_breakpoint_hook = gdbtk_enable_breakpoint; | |
600 | disable_breakpoint_hook = gdbtk_disable_breakpoint; | |
637b1661 | 601 | interactive_hook = gdbtk_interactive; |
479f0f18 SG |
602 | target_wait_hook = gdbtk_wait; |
603 | call_command_hook = gdbtk_call_command; | |
754e5da2 SG |
604 | |
605 | discard_cleanups (old_chain); | |
606 | ||
607 | add_com ("tk", class_obscure, tk_command, | |
608 | "Send a command directly into tk."); | |
609 | } | |
610 | ||
611 | /* Come here during initialze_all_files () */ | |
612 | ||
613 | void | |
614 | _initialize_gdbtk () | |
615 | { | |
c5197511 SG |
616 | if (use_windows) |
617 | { | |
618 | /* Tell the rest of the world that Gdbtk is now set up. */ | |
754e5da2 | 619 | |
c5197511 SG |
620 | init_ui_hook = gdbtk_init; |
621 | } | |
754e5da2 | 622 | } |