1 /* Startup code for gdbtk.
2 Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
4 Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
31 #include "tracepoint.h"
48 /* start-sanitize-ide */
52 /* end-sanitize-ide */
55 #ifdef ANSI_PROTOTYPES
65 #include <sys/ioctl.h>
66 #include "gdb_string.h"
76 extern int (*ui_load_progress_hook
) PARAMS ((char *, unsigned long));
77 extern void (*pre_add_symbol_hook
) PARAMS ((char *));
78 extern void (*post_add_symbol_hook
) PARAMS ((void));
79 extern void (*selected_frame_level_changed_hook
) PARAMS ((int));
82 extern void (*ui_loop_hook
) PARAMS ((int));
85 static void gdbtk_create_tracepoint
PARAMS ((struct tracepoint
*));
86 static void gdbtk_delete_tracepoint
PARAMS ((struct tracepoint
*));
87 static void gdbtk_modify_tracepoint
PARAMS ((struct tracepoint
*));
88 static void gdbtk_create_breakpoint
PARAMS ((struct breakpoint
*));
89 static void gdbtk_delete_breakpoint
PARAMS ((struct breakpoint
*));
90 static void gdbtk_modify_breakpoint
PARAMS ((struct breakpoint
*));
91 static void tk_command_loop
PARAMS ((void));
92 static void gdbtk_call_command
PARAMS ((struct cmd_list_element
*, char *, int));
93 static int gdbtk_wait
PARAMS ((int, struct target_waitstatus
*));
94 void x_event
PARAMS ((int));
95 static int gdbtk_query
PARAMS ((const char *, va_list));
96 static void gdbtk_warning
PARAMS ((const char *, va_list));
97 void gdbtk_ignorable_warning
PARAMS ((const char *));
98 static char* gdbtk_readline
PARAMS ((char *));
100 #ifdef ANSI_PROTOTYPES
101 gdbtk_readline_begin (char *format
, ...);
103 gdbtk_readline_begin ();
105 static void gdbtk_readline_end
PARAMS ((void));
106 static void gdbtk_flush
PARAMS ((FILE *));
107 static void gdbtk_pre_add_symbol
PARAMS ((char *));
108 static void gdbtk_print_frame_info
PARAMS ((struct symtab
*, int, int, int));
109 static void gdbtk_post_add_symbol
PARAMS ((void));
110 static void pc_changed
PARAMS ((void));
111 static void tracepoint_notify
PARAMS ((struct tracepoint
*, const char *));
112 static void gdbtk_selected_frame_changed
PARAMS ((int));
113 static void gdbtk_context_change
PARAMS ((int));
116 * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
117 * See note there for details.
120 void gdbtk_fputs
PARAMS ((const char *, FILE *));
121 int gdbtk_load_hash
PARAMS ((char *, unsigned long));
122 static void breakpoint_notify
PARAMS ((struct breakpoint
*, const char *));
125 * gdbtk_add_hooks - add all the hooks to gdb. This will get called by the
126 * startup code to fill in the hooks needed by core gdb.
130 gdbtk_add_hooks(void)
132 command_loop_hook
= tk_command_loop
;
133 call_command_hook
= gdbtk_call_command
;
134 readline_begin_hook
= gdbtk_readline_begin
;
135 readline_hook
= gdbtk_readline
;
136 readline_end_hook
= gdbtk_readline_end
;
138 print_frame_info_listing_hook
= gdbtk_print_frame_info
;
139 query_hook
= gdbtk_query
;
140 warning_hook
= gdbtk_warning
;
141 flush_hook
= gdbtk_flush
;
143 create_breakpoint_hook
= gdbtk_create_breakpoint
;
144 delete_breakpoint_hook
= gdbtk_delete_breakpoint
;
145 modify_breakpoint_hook
= gdbtk_modify_breakpoint
;
147 interactive_hook
= gdbtk_interactive
;
148 target_wait_hook
= gdbtk_wait
;
149 ui_load_progress_hook
= gdbtk_load_hash
;
151 ui_loop_hook
= x_event
;
153 pre_add_symbol_hook
= gdbtk_pre_add_symbol
;
154 post_add_symbol_hook
= gdbtk_post_add_symbol
;
156 create_tracepoint_hook
= gdbtk_create_tracepoint
;
157 delete_tracepoint_hook
= gdbtk_delete_tracepoint
;
158 modify_tracepoint_hook
= gdbtk_modify_tracepoint
;
159 pc_changed_hook
= pc_changed
;
160 selected_frame_level_changed_hook
= gdbtk_selected_frame_changed
;
161 context_hook
= gdbtk_context_change
;
164 /* These control where to put the gdb output which is created by
165 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
166 lowest level of these routines and capture all output from the rest of GDB.
168 The reason to use the result_ptr rather than the gdbtk_interp's result
169 directly is so that a call_wrapper invoked function can preserve its result
170 across calls into Tcl which might be made in the course of the function's
173 * result_ptr->obj_ptr is where to accumulate the result.
174 * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
175 instead of to the result_ptr.
176 * GDBTK_MAKES_LIST flag means add to the result as a list element.
180 gdbtk_result
*result_ptr
= NULL
;
183 /* This allows you to Tcl_Eval a tcl command which takes
184 a command word, and then a single argument. */
186 int gdbtk_two_elem_cmd (cmd_name
, argv1
)
191 int result
, flags_ptr
, arg_len
, cmd_len
;
193 arg_len
= Tcl_ScanElement (argv1
, &flags_ptr
);
194 cmd_len
= strlen (cmd_name
);
195 command
= malloc(arg_len
+ cmd_len
+ 2);
196 strcpy (command
, cmd_name
);
197 strcat (command
, " ");
199 Tcl_ConvertElement (argv1
, command
+ cmd_len
+ 1, flags_ptr
);
201 result
= Tcl_Eval (gdbtk_interp
, command
);
212 /* Force immediate screen update */
214 Tcl_VarEval (gdbtk_interp
, "gdbtk_tcl_flush", NULL
);
218 /* This handles all the output from gdb. All the gdb printf_xxx functions
219 * eventually end up here. The output is either passed to the result_ptr
220 * where it will go to the result of some gdbtk command, or passed to the
221 * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
226 * 1) result_ptr == NULL - This happens when some output comes from gdb which
227 * is not generated by a command in gdbtk-cmds, usually startup stuff.
228 * In this case we just route the data to gdbtk_tcl_fputs.
229 * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
230 * We place the data into the result_ptr, either as a string,
231 * or a list, depending whether the GDBTK_MAKES_LIST bit is set.
232 * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
233 * UNLESS it was coming to stderr. Then we place it in the result_ptr
234 * anyway, so it can be dealt with.
239 gdbtk_fputs (ptr
, stream
)
245 if (result_ptr
!= NULL
)
247 if (result_ptr
->flags
& GDBTK_TO_RESULT
)
249 if (result_ptr
->flags
& GDBTK_MAKES_LIST
)
250 Tcl_ListObjAppendElement(NULL
, result_ptr
->obj_ptr
,
251 Tcl_NewStringObj((char *) ptr
, -1));
253 Tcl_AppendToObj (result_ptr
->obj_ptr
, (char *) ptr
, -1);
255 else if (stream
== gdb_stderr
)
257 if (result_ptr
->flags
& GDBTK_ERROR_STARTED
)
258 Tcl_AppendToObj (result_ptr
->obj_ptr
, (char *) ptr
, -1);
261 Tcl_SetStringObj (result_ptr
->obj_ptr
, (char *) ptr
, -1);
262 result_ptr
->flags
|= GDBTK_ERROR_STARTED
;
267 gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr
);
268 if (result_ptr
->flags
& GDBTK_MAKES_LIST
)
269 gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
274 gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr
);
281 * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
285 gdbtk_warning (warning
, args
)
291 vsprintf (buf
, warning
, args
);
292 gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf
);
297 * This routes all ignorable warnings to the Tcl function
298 * "gdbtk_tcl_ignorable_warning".
302 gdbtk_ignorable_warning (warning
)
306 sprintf (buf
, warning
);
307 gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf
);
313 Tcl_Eval (gdbtk_interp
, "gdbtk_pc_changed");
317 /* This function is called instead of gdb's internal command loop. This is the
318 last chance to do anything before entering the main Tk event loop.
319 At the end of the command, we enter the main loop. */
324 extern GDB_FILE
*instream
;
326 /* We no longer want to use stdin as the command input stream */
329 if (Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_preloop") != TCL_OK
)
333 /* Force errorInfo to be set up propertly. */
334 Tcl_AddErrorInfo (gdbtk_interp
, "");
336 msg
= Tcl_GetVar (gdbtk_interp
, "errorInfo", TCL_GLOBAL_ONLY
);
338 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
340 fputs_unfiltered (msg
, gdb_stderr
);
351 /* Come here when there is activity on the X file descriptor. */
357 static int in_x_event
= 0;
358 static Tcl_Obj
*varname
= NULL
;
359 if (in_x_event
|| in_fputs
)
369 /* Process pending events */
370 while (Tcl_DoOneEvent (TCL_DONT_WAIT
|TCL_ALL_EVENTS
) != 0)
373 if (load_in_progress
)
378 Tcl_Obj
*varnamestrobj
= Tcl_NewStringObj("download_cancel_ok",-1);
379 varname
= Tcl_ObjGetVar2(gdbtk_interp
,varnamestrobj
,NULL
,TCL_GLOBAL_ONLY
);
381 if ((Tcl_GetIntFromObj(gdbtk_interp
,varname
,&val
) == TCL_OK
) && val
)
397 #ifdef ANSI_PROTOTYPES
398 gdbtk_readline_begin (char *format
, ...)
400 gdbtk_readline_begin (va_alist
)
407 #ifdef ANSI_PROTOTYPES
408 va_start (args
, format
);
412 format
= va_arg (args
, char *);
415 vsprintf (buf
, format
, args
);
416 gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf
);
421 gdbtk_readline (prompt
)
430 result
= gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt
);
432 if (result
== TCL_OK
)
434 return (strdup (gdbtk_interp
-> result
));
438 gdbtk_fputs (gdbtk_interp
-> result
, gdb_stdout
);
439 gdbtk_fputs ("\n", gdb_stdout
);
445 gdbtk_readline_end ()
447 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_readline_end");
451 gdbtk_call_command (cmdblk
, arg
, from_tty
)
452 struct cmd_list_element
*cmdblk
;
457 if (cmdblk
->class == class_run
|| cmdblk
->class == class_trace
)
460 /* HACK! HACK! This is to get the gui to update the tstart/tstop
461 button only incase of tstart/tstop commands issued from the console
462 We don't want to update the src window, so we need to have specific
463 procedures to do tstart and tstop
464 Unfortunately this will not display errors from tstart or tstop in the
465 console window itself, but as dialogs.*/
467 if (!strcmp(cmdblk
->name
, "tstart") && !No_Update
)
469 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_tstart");
470 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
472 else if (!strcmp(cmdblk
->name
, "tstop") && !No_Update
)
474 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_tstop");
475 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
482 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_busy");
483 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
486 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_idle");
490 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
493 /* The next three functions use breakpoint_notify to allow the GUI
494 * to handle creating, deleting and modifying breakpoints. These three
495 * functions are put into the appropriate gdb hooks in gdbtk_init.
499 gdbtk_create_breakpoint(b
)
500 struct breakpoint
*b
;
502 breakpoint_notify (b
, "create");
506 gdbtk_delete_breakpoint(b
)
507 struct breakpoint
*b
;
509 breakpoint_notify (b
, "delete");
513 gdbtk_modify_breakpoint(b
)
514 struct breakpoint
*b
;
516 breakpoint_notify (b
, "modify");
519 /* This is the generic function for handling changes in
520 * a breakpoint. It routes the information to the Tcl
521 * command "gdbtk_tcl_breakpoint" in the form:
522 * gdbtk_tcl_breakpoint action b_number b_address b_line b_file
523 * On error, the error string is written to gdb_stdout.
527 breakpoint_notify(b
, action
)
528 struct breakpoint
*b
;
533 struct symtab_and_line sal
;
536 if (b
->type
!= bp_breakpoint
)
539 /* We ensure that ACTION contains no special Tcl characters, so we
541 sal
= find_pc_line (b
->address
, 0);
542 filename
= symtab_to_filename (sal
.symtab
);
543 if (filename
== NULL
)
546 sprintf (buf
, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action
, b
->number
,
547 (long)b
->address
, b
->line_number
, filename
);
549 v
= Tcl_Eval (gdbtk_interp
, buf
);
553 gdbtk_fputs (Tcl_GetStringResult (gdbtk_interp
), gdb_stdout
);
554 gdbtk_fputs ("\n", gdb_stdout
);
559 gdbtk_load_hash (section
, num
)
564 sprintf (buf
, "download_hash %s %ld", section
, num
);
565 Tcl_Eval (gdbtk_interp
, buf
);
566 return atoi (gdbtk_interp
->result
);
570 /* This hook is called whenever we are ready to load a symbol file so that
571 the UI can notify the user... */
573 gdbtk_pre_add_symbol (name
)
577 gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name
);
581 /* This hook is called whenever we finish loading a symbol file. */
583 gdbtk_post_add_symbol ()
585 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_post_add_symbol");
588 /* This hook function is called whenever we want to wait for the
592 gdbtk_wait (pid
, ourstatus
)
594 struct target_waitstatus
*ourstatus
;
596 gdbtk_start_timer ();
597 pid
= target_wait (pid
, ourstatus
);
603 * This handles all queries from gdb.
604 * The first argument is a printf style format statement, the rest are its
605 * arguments. The resultant formatted string is passed to the Tcl function
607 * It returns the users response to the query, as well as putting the value
608 * in the result field of the Tcl interpreter.
612 gdbtk_query (query
, args
)
619 vsprintf (buf
, query
, args
);
620 gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf
);
622 val
= atol (gdbtk_interp
->result
);
628 gdbtk_print_frame_info (s
, line
, stopline
, noerror
)
634 current_source_symtab
= s
;
635 current_source_line
= line
;
639 gdbtk_create_tracepoint (tp
)
640 struct tracepoint
*tp
;
642 tracepoint_notify (tp
, "create");
646 gdbtk_delete_tracepoint (tp
)
647 struct tracepoint
*tp
;
649 tracepoint_notify (tp
, "delete");
653 gdbtk_modify_tracepoint (tp
)
654 struct tracepoint
*tp
;
656 tracepoint_notify (tp
, "modify");
660 tracepoint_notify(tp
, action
)
661 struct tracepoint
*tp
;
666 struct symtab_and_line sal
;
669 /* We ensure that ACTION contains no special Tcl characters, so we
671 sal
= find_pc_line (tp
->address
, 0);
673 filename
= symtab_to_filename (sal
.symtab
);
674 if (filename
== NULL
)
676 sprintf (buf
, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s} %d", action
, tp
->number
,
677 (long)tp
->address
, sal
.line
, filename
, tp
->pass_count
);
679 v
= Tcl_Eval (gdbtk_interp
, buf
);
683 gdbtk_fputs (gdbtk_interp
->result
, gdb_stdout
);
684 gdbtk_fputs ("\n", gdb_stdout
);
689 gdbtk_selected_frame_changed (level
)
692 Tcl_UpdateLinkedVar (gdbtk_interp
, "gdb_selected_frame_level");
695 /* Called when the current thread changes. */
696 /* gdb_context is linked to the tcl variable "gdb_context_id" */
698 gdbtk_context_change (num
)