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