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 | { | |
246 | struct frame_info *frame; | |
247 | struct symbol *func; | |
754e5da2 SG |
248 | |
249 | frame = get_frame_info (selected_frame); | |
8532893d | 250 | |
754e5da2 | 251 | pc = frame ? frame->pc : stop_pc; |
8532893d | 252 | |
754e5da2 SG |
253 | sal = find_pc_line (pc, 0); |
254 | } | |
255 | else if (argc == 2) | |
256 | { | |
754e5da2 | 257 | struct symtabs_and_lines sals; |
8532893d | 258 | int nelts; |
754e5da2 SG |
259 | |
260 | sals = decode_line_spec (argv[1], 1); | |
261 | ||
8532893d SG |
262 | nelts = sals.nelts; |
263 | sal = sals.sals[0]; | |
264 | free (sals.sals); | |
265 | ||
754e5da2 SG |
266 | if (sals.nelts != 1) |
267 | { | |
268 | Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC); | |
754e5da2 SG |
269 | return TCL_ERROR; |
270 | } | |
271 | ||
8532893d | 272 | pc = sal.pc; |
754e5da2 SG |
273 | } |
274 | else | |
275 | { | |
276 | Tcl_SetResult (interp, "wrong # args", TCL_STATIC); | |
277 | return TCL_ERROR; | |
278 | } | |
279 | ||
754e5da2 SG |
280 | if (sal.symtab) |
281 | Tcl_AppendElement (interp, sal.symtab->filename); | |
282 | else | |
283 | Tcl_AppendElement (interp, ""); | |
8532893d SG |
284 | |
285 | find_pc_partial_function (pc, &funcname, NULL, NULL); | |
754e5da2 | 286 | Tcl_AppendElement (interp, funcname); |
8532893d | 287 | |
637b1661 | 288 | filename = symtab_to_filename (sal.symtab); |
754e5da2 | 289 | Tcl_AppendElement (interp, filename); |
8532893d SG |
290 | |
291 | sprintf (buf, "%d", sal.line); | |
754e5da2 SG |
292 | Tcl_AppendElement (interp, buf); /* line number */ |
293 | ||
8532893d SG |
294 | sprintf (buf, "0x%x", pc); |
295 | Tcl_AppendElement (interp, buf); /* PC */ | |
296 | ||
754e5da2 SG |
297 | return TCL_OK; |
298 | } | |
299 | \f | |
300 | static int | |
301 | gdb_cmd_stub (cmd) | |
302 | char *cmd; | |
303 | { | |
304 | execute_command (cmd, 1); | |
305 | ||
306 | return 1; /* Indicate success */ | |
307 | } | |
308 | ||
309 | /* This implements the TCL command `gdb_cmd', which sends it's argument into | |
310 | the GDB command scanner. */ | |
311 | ||
312 | static int | |
313 | gdb_cmd (clientData, interp, argc, argv) | |
314 | ClientData clientData; | |
315 | Tcl_Interp *interp; | |
316 | int argc; | |
317 | char *argv[]; | |
318 | { | |
319 | int val; | |
320 | struct cleanup *old_chain; | |
321 | ||
322 | if (argc != 2) | |
323 | { | |
324 | Tcl_SetResult (interp, "wrong # args", TCL_STATIC); | |
325 | return TCL_ERROR; | |
326 | } | |
327 | ||
328 | old_chain = make_cleanup (null_routine, 0); | |
329 | ||
330 | val = catch_errors (gdb_cmd_stub, argv[1], "", RETURN_MASK_ERROR); | |
331 | ||
479f0f18 SG |
332 | /* In case of an error, we may need to force the GUI into idle mode because |
333 | gdbtk_call_command may have bombed out while in the command routine. */ | |
334 | ||
335 | if (val == 0) | |
336 | Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL); | |
337 | ||
754e5da2 SG |
338 | bpstat_do_actions (&stop_bpstat); |
339 | do_cleanups (old_chain); | |
340 | ||
8532893d SG |
341 | /* Drain all buffered command output */ |
342 | ||
343 | gdb_flush (gdb_stderr); | |
344 | gdb_flush (gdb_stdout); | |
345 | ||
754e5da2 SG |
346 | /* We could base the return value on val, but that would require most users |
347 | to use catch. Since GDB errors are already being handled elsewhere, I | |
348 | see no reason to pass them up to the caller. */ | |
349 | ||
350 | return TCL_OK; | |
351 | } | |
352 | ||
353 | static int | |
354 | gdb_listfiles (clientData, interp, argc, argv) | |
355 | ClientData clientData; | |
356 | Tcl_Interp *interp; | |
357 | int argc; | |
358 | char *argv[]; | |
359 | { | |
360 | int val; | |
361 | struct objfile *objfile; | |
362 | struct partial_symtab *psymtab; | |
363 | ||
364 | ALL_PSYMTABS (objfile, psymtab) | |
365 | Tcl_AppendElement (interp, psymtab->filename); | |
366 | ||
367 | return TCL_OK; | |
368 | } | |
479f0f18 SG |
369 | |
370 | static int | |
371 | gdb_stop (clientData, interp, argc, argv) | |
372 | ClientData clientData; | |
373 | Tcl_Interp *interp; | |
374 | int argc; | |
375 | char *argv[]; | |
376 | { | |
377 | extern pid_t inferior_process_group; | |
378 | ||
379 | /* XXX - This is WRONG for remote targets. Probably need a target vector | |
380 | entry to do this right. */ | |
381 | ||
382 | kill (-inferior_process_group, SIGINT); | |
383 | } | |
384 | ||
754e5da2 SG |
385 | \f |
386 | static void | |
387 | tk_command (cmd, from_tty) | |
388 | char *cmd; | |
389 | int from_tty; | |
390 | { | |
391 | Tcl_VarEval (interp, cmd, NULL); | |
392 | ||
393 | gdbtk_fputs (interp->result); | |
394 | gdbtk_fputs ("\n"); | |
395 | } | |
396 | ||
397 | static void | |
398 | cleanup_init (ignored) | |
399 | int ignored; | |
400 | { | |
401 | if (mainWindow != NULL) | |
402 | Tk_DestroyWindow (mainWindow); | |
403 | mainWindow = NULL; | |
404 | ||
405 | if (interp != NULL) | |
406 | Tcl_DeleteInterp (interp); | |
407 | interp = NULL; | |
408 | } | |
409 | ||
637b1661 SG |
410 | /* Come here during long calculations to check for GUI events. Usually invoked |
411 | via the QUIT macro. */ | |
412 | ||
413 | static void | |
414 | gdbtk_interactive () | |
415 | { | |
416 | /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */ | |
417 | } | |
418 | ||
479f0f18 SG |
419 | /* Come here when there is activity on the X file descriptor. */ |
420 | ||
421 | static void | |
422 | x_event (signo) | |
423 | int signo; | |
424 | { | |
425 | /* Process pending events */ | |
426 | ||
427 | while (Tk_DoOneEvent (TK_DONT_WAIT|TK_ALL_EVENTS) != 0); | |
428 | } | |
429 | ||
430 | static int | |
431 | gdbtk_wait (pid, ourstatus) | |
432 | int pid; | |
433 | struct target_waitstatus *ourstatus; | |
434 | { | |
435 | signal (SIGIO, x_event); | |
436 | ||
437 | pid = target_wait (pid, ourstatus); | |
438 | ||
439 | signal (SIGIO, SIG_IGN); | |
440 | ||
441 | return pid; | |
442 | } | |
443 | ||
444 | /* This is called from execute_command, and provides a wrapper around | |
445 | various command routines in a place where both protocol messages and | |
446 | user input both flow through. Mostly this is used for indicating whether | |
447 | the target process is running or not. | |
448 | */ | |
449 | ||
450 | static void | |
451 | gdbtk_call_command (cmdblk, arg, from_tty) | |
452 | struct cmd_list_element *cmdblk; | |
453 | char *arg; | |
454 | int from_tty; | |
455 | { | |
456 | if (cmdblk->class == class_run) | |
457 | { | |
458 | Tcl_VarEval (interp, "gdbtk_tcl_busy", NULL); | |
459 | (*cmdblk->function.cfunc)(arg, from_tty); | |
460 | Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL); | |
461 | } | |
462 | else | |
463 | (*cmdblk->function.cfunc)(arg, from_tty); | |
464 | } | |
465 | ||
754e5da2 SG |
466 | static void |
467 | gdbtk_init () | |
468 | { | |
469 | struct cleanup *old_chain; | |
470 | char *gdbtk_filename; | |
479f0f18 | 471 | int i; |
754e5da2 SG |
472 | |
473 | old_chain = make_cleanup (cleanup_init, 0); | |
474 | ||
475 | /* First init tcl and tk. */ | |
476 | ||
477 | interp = Tcl_CreateInterp (); | |
478 | ||
479 | if (!interp) | |
480 | error ("Tcl_CreateInterp failed"); | |
481 | ||
482 | mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb"); | |
483 | ||
484 | if (!mainWindow) | |
485 | return; /* DISPLAY probably not set */ | |
486 | ||
487 | if (Tcl_Init(interp) != TCL_OK) | |
488 | error ("Tcl_Init failed: %s", interp->result); | |
489 | ||
490 | if (Tk_Init(interp) != TCL_OK) | |
491 | error ("Tk_Init failed: %s", interp->result); | |
492 | ||
493 | Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL); | |
494 | Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL); | |
495 | Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL); | |
479f0f18 | 496 | Tcl_CreateCommand (interp, "gdb_stop", gdb_stop, NULL, NULL); |
754e5da2 SG |
497 | |
498 | gdbtk_filename = getenv ("GDBTK_FILENAME"); | |
8532893d SG |
499 | if (!gdbtk_filename) |
500 | if (access ("gdbtk.tcl", R_OK) == 0) | |
501 | gdbtk_filename = "gdbtk.tcl"; | |
502 | else | |
503 | gdbtk_filename = GDBTK_FILENAME; | |
504 | ||
505 | if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK) | |
506 | error ("Failure reading %s: %s", gdbtk_filename, interp->result); | |
754e5da2 | 507 | |
cd2df226 | 508 | /* Get the file descriptor for the X server */ |
479f0f18 | 509 | |
cd2df226 | 510 | x_fd = ConnectionNumber (Tk_Display (mainWindow)); |
479f0f18 SG |
511 | |
512 | /* Setup for I/O interrupts */ | |
513 | ||
514 | signal (SIGIO, SIG_IGN); | |
515 | ||
516 | i = fcntl (x_fd, F_GETFL, 0); | |
517 | fcntl (x_fd, F_SETFL, i|FASYNC); | |
518 | fcntl (x_fd, F_SETOWN, getpid()); | |
519 | ||
754e5da2 SG |
520 | command_loop_hook = Tk_MainLoop; |
521 | fputs_unfiltered_hook = gdbtk_fputs; | |
522 | print_frame_info_listing_hook = null_routine; | |
523 | query_hook = gdbtk_query; | |
524 | flush_hook = gdbtk_flush; | |
525 | create_breakpoint_hook = gdbtk_create_breakpoint; | |
526 | delete_breakpoint_hook = gdbtk_delete_breakpoint; | |
527 | enable_breakpoint_hook = gdbtk_enable_breakpoint; | |
528 | disable_breakpoint_hook = gdbtk_disable_breakpoint; | |
637b1661 | 529 | interactive_hook = gdbtk_interactive; |
479f0f18 SG |
530 | target_wait_hook = gdbtk_wait; |
531 | call_command_hook = gdbtk_call_command; | |
754e5da2 SG |
532 | |
533 | discard_cleanups (old_chain); | |
534 | ||
535 | add_com ("tk", class_obscure, tk_command, | |
536 | "Send a command directly into tk."); | |
537 | } | |
538 | ||
539 | /* Come here during initialze_all_files () */ | |
540 | ||
541 | void | |
542 | _initialize_gdbtk () | |
543 | { | |
c5197511 SG |
544 | if (use_windows) |
545 | { | |
546 | /* Tell the rest of the world that Gdbtk is now set up. */ | |
754e5da2 | 547 | |
c5197511 SG |
548 | init_ui_hook = gdbtk_init; |
549 | } | |
754e5da2 | 550 | } |