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));
81 extern void (*ui_loop_hook
) PARAMS ((int));
84 static void gdbtk_create_tracepoint
PARAMS ((struct tracepoint
*));
85 static void gdbtk_delete_tracepoint
PARAMS ((struct tracepoint
*));
86 static void gdbtk_modify_tracepoint
PARAMS ((struct tracepoint
*));
87 static void gdbtk_trace_find
PARAMS ((char *arg
, int from_tty
));
88 static void gdbtk_trace_start_stop
PARAMS ((int, int));
89 static void gdbtk_create_breakpoint
PARAMS ((struct breakpoint
*));
90 static void gdbtk_delete_breakpoint
PARAMS ((struct breakpoint
*));
91 static void gdbtk_modify_breakpoint
PARAMS ((struct breakpoint
*));
92 static void gdbtk_file_changed
PARAMS ((char *));
93 static void gdbtk_exec_file_display
PARAMS ((char *));
94 static void tk_command_loop
PARAMS ((void));
95 static void gdbtk_call_command
PARAMS ((struct cmd_list_element
*, char *, int));
96 static int gdbtk_wait
PARAMS ((int, struct target_waitstatus
*));
97 void x_event
PARAMS ((int));
98 static int gdbtk_query
PARAMS ((const char *, va_list));
99 static void gdbtk_warning
PARAMS ((const char *, va_list));
100 void gdbtk_ignorable_warning
PARAMS ((const char *));
101 static char* gdbtk_readline
PARAMS ((char *));
103 #ifdef ANSI_PROTOTYPES
104 gdbtk_readline_begin (char *format
, ...);
106 gdbtk_readline_begin ();
108 static void gdbtk_readline_end
PARAMS ((void));
109 static void gdbtk_flush
PARAMS ((FILE *));
110 static void gdbtk_pre_add_symbol
PARAMS ((char *));
111 static void gdbtk_print_frame_info
PARAMS ((struct symtab
*, int, int, int));
112 static void gdbtk_post_add_symbol
PARAMS ((void));
113 static void pc_changed
PARAMS ((void));
114 static void tracepoint_notify
PARAMS ((struct tracepoint
*, const char *));
115 static void gdbtk_selected_frame_changed
PARAMS ((int));
116 static void gdbtk_context_change
PARAMS ((int));
119 * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
120 * See note there for details.
123 void gdbtk_fputs
PARAMS ((const char *, FILE *));
124 int gdbtk_load_hash
PARAMS ((char *, unsigned long));
125 static void breakpoint_notify
PARAMS ((struct breakpoint
*, const char *));
128 * gdbtk_add_hooks - add all the hooks to gdb. This will get called by the
129 * startup code to fill in the hooks needed by core gdb.
133 gdbtk_add_hooks(void)
135 command_loop_hook
= tk_command_loop
;
136 call_command_hook
= gdbtk_call_command
;
137 readline_begin_hook
= gdbtk_readline_begin
;
138 readline_hook
= gdbtk_readline
;
139 readline_end_hook
= gdbtk_readline_end
;
141 print_frame_info_listing_hook
= gdbtk_print_frame_info
;
142 query_hook
= gdbtk_query
;
143 warning_hook
= gdbtk_warning
;
144 flush_hook
= gdbtk_flush
;
146 create_breakpoint_hook
= gdbtk_create_breakpoint
;
147 delete_breakpoint_hook
= gdbtk_delete_breakpoint
;
148 modify_breakpoint_hook
= gdbtk_modify_breakpoint
;
150 interactive_hook
= gdbtk_interactive
;
151 target_wait_hook
= gdbtk_wait
;
152 ui_load_progress_hook
= gdbtk_load_hash
;
155 ui_loop_hook
= x_event
;
157 pre_add_symbol_hook
= gdbtk_pre_add_symbol
;
158 post_add_symbol_hook
= gdbtk_post_add_symbol
;
159 file_changed_hook
= gdbtk_file_changed
;
160 exec_file_display_hook
= gdbtk_exec_file_display
;
162 create_tracepoint_hook
= gdbtk_create_tracepoint
;
163 delete_tracepoint_hook
= gdbtk_delete_tracepoint
;
164 modify_tracepoint_hook
= gdbtk_modify_tracepoint
;
165 trace_find_hook
= gdbtk_trace_find
;
166 trace_start_stop_hook
= gdbtk_trace_start_stop
;
167 pc_changed_hook
= pc_changed
;
168 selected_frame_level_changed_hook
= gdbtk_selected_frame_changed
;
169 context_hook
= gdbtk_context_change
;
172 /* These control where to put the gdb output which is created by
173 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
174 lowest level of these routines and capture all output from the rest of GDB.
176 The reason to use the result_ptr rather than the gdbtk_interp's result
177 directly is so that a call_wrapper invoked function can preserve its result
178 across calls into Tcl which might be made in the course of the function's
181 * result_ptr->obj_ptr is where to accumulate the result.
182 * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
183 instead of to the result_ptr.
184 * GDBTK_MAKES_LIST flag means add to the result as a list element.
188 gdbtk_result
*result_ptr
= NULL
;
191 /* This allows you to Tcl_Eval a tcl command which takes
192 a command word, and then a single argument. */
194 int gdbtk_two_elem_cmd (cmd_name
, argv1
)
199 int result
, flags_ptr
, arg_len
, cmd_len
;
201 arg_len
= Tcl_ScanElement (argv1
, &flags_ptr
);
202 cmd_len
= strlen (cmd_name
);
203 command
= malloc(arg_len
+ cmd_len
+ 2);
204 strcpy (command
, cmd_name
);
205 strcat (command
, " ");
207 Tcl_ConvertElement (argv1
, command
+ cmd_len
+ 1, flags_ptr
);
209 result
= Tcl_Eval (gdbtk_interp
, command
);
220 /* Force immediate screen update */
222 Tcl_VarEval (gdbtk_interp
, "gdbtk_tcl_flush", NULL
);
226 /* This handles all the output from gdb. All the gdb printf_xxx functions
227 * eventually end up here. The output is either passed to the result_ptr
228 * where it will go to the result of some gdbtk command, or passed to the
229 * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
234 * 1) result_ptr == NULL - This happens when some output comes from gdb which
235 * is not generated by a command in gdbtk-cmds, usually startup stuff.
236 * In this case we just route the data to gdbtk_tcl_fputs.
237 * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
238 * We place the data into the result_ptr, either as a string,
239 * or a list, depending whether the GDBTK_MAKES_LIST bit is set.
240 * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
241 * UNLESS it was coming to stderr. Then we place it in the result_ptr
242 * anyway, so it can be dealt with.
247 gdbtk_fputs (ptr
, stream
)
253 if (result_ptr
!= NULL
)
255 if (result_ptr
->flags
& GDBTK_TO_RESULT
)
257 if (result_ptr
->flags
& GDBTK_MAKES_LIST
)
258 Tcl_ListObjAppendElement(NULL
, result_ptr
->obj_ptr
,
259 Tcl_NewStringObj((char *) ptr
, -1));
261 Tcl_AppendToObj (result_ptr
->obj_ptr
, (char *) ptr
, -1);
263 else if (stream
== gdb_stderr
)
265 if (result_ptr
->flags
& GDBTK_ERROR_STARTED
)
266 Tcl_AppendToObj (result_ptr
->obj_ptr
, (char *) ptr
, -1);
269 Tcl_SetStringObj (result_ptr
->obj_ptr
, (char *) ptr
, -1);
270 result_ptr
->flags
|= GDBTK_ERROR_STARTED
;
275 gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr
);
276 if (result_ptr
->flags
& GDBTK_MAKES_LIST
)
277 gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
282 gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr
);
289 * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
293 gdbtk_warning (warning
, args
)
299 vsprintf (buf
, warning
, args
);
300 gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf
);
305 * This routes all ignorable warnings to the Tcl function
306 * "gdbtk_tcl_ignorable_warning".
310 gdbtk_ignorable_warning (warning
)
314 sprintf (buf
, warning
);
315 gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf
);
321 Tcl_Eval (gdbtk_interp
, "gdbtk_pc_changed");
325 /* This function is called instead of gdb's internal command loop. This is the
326 last chance to do anything before entering the main Tk event loop.
327 At the end of the command, we enter the main loop. */
332 extern GDB_FILE
*instream
;
334 /* We no longer want to use stdin as the command input stream */
337 if (Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_preloop") != TCL_OK
)
341 /* Force errorInfo to be set up propertly. */
342 Tcl_AddErrorInfo (gdbtk_interp
, "");
344 msg
= Tcl_GetVar (gdbtk_interp
, "errorInfo", TCL_GLOBAL_ONLY
);
346 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
348 fputs_unfiltered (msg
, gdb_stderr
);
359 /* Come here when there is activity on the X file descriptor. */
365 static int in_x_event
= 0;
366 static Tcl_Obj
*varname
= NULL
;
367 if (in_x_event
|| in_fputs
)
377 /* Process pending events */
378 while (Tcl_DoOneEvent (TCL_DONT_WAIT
|TCL_ALL_EVENTS
) != 0)
381 if (load_in_progress
)
386 Tcl_Obj
*varnamestrobj
= Tcl_NewStringObj("download_cancel_ok",-1);
387 varname
= Tcl_ObjGetVar2(gdbtk_interp
,varnamestrobj
,NULL
,TCL_GLOBAL_ONLY
);
389 if ((Tcl_GetIntFromObj(gdbtk_interp
,varname
,&val
) == TCL_OK
) && val
)
405 #ifdef ANSI_PROTOTYPES
406 gdbtk_readline_begin (char *format
, ...)
408 gdbtk_readline_begin (va_alist
)
415 #ifdef ANSI_PROTOTYPES
416 va_start (args
, format
);
420 format
= va_arg (args
, char *);
423 vsprintf (buf
, format
, args
);
424 gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf
);
429 gdbtk_readline (prompt
)
438 result
= gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt
);
440 if (result
== TCL_OK
)
442 return (strdup (gdbtk_interp
-> result
));
446 gdbtk_fputs (gdbtk_interp
-> result
, gdb_stdout
);
447 gdbtk_fputs ("\n", gdb_stdout
);
453 gdbtk_readline_end ()
455 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_readline_end");
459 gdbtk_call_command (cmdblk
, arg
, from_tty
)
460 struct cmd_list_element
*cmdblk
;
465 if (cmdblk
->class == class_run
|| cmdblk
->class == class_trace
)
470 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_busy");
471 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
474 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_idle");
477 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
480 /* The next three functions use breakpoint_notify to allow the GUI
481 * to handle creating, deleting and modifying breakpoints. These three
482 * functions are put into the appropriate gdb hooks in gdbtk_init.
486 gdbtk_create_breakpoint(b
)
487 struct breakpoint
*b
;
489 breakpoint_notify (b
, "create");
493 gdbtk_delete_breakpoint(b
)
494 struct breakpoint
*b
;
496 breakpoint_notify (b
, "delete");
500 gdbtk_modify_breakpoint(b
)
501 struct breakpoint
*b
;
503 breakpoint_notify (b
, "modify");
506 /* This is the generic function for handling changes in
507 * a breakpoint. It routes the information to the Tcl
508 * command "gdbtk_tcl_breakpoint" in the form:
509 * gdbtk_tcl_breakpoint action b_number b_address b_line b_file
510 * On error, the error string is written to gdb_stdout.
514 breakpoint_notify(b
, action
)
515 struct breakpoint
*b
;
520 struct symtab_and_line sal
;
523 if (b
->type
!= bp_breakpoint
)
526 /* We ensure that ACTION contains no special Tcl characters, so we
528 sal
= find_pc_line (b
->address
, 0);
529 filename
= symtab_to_filename (sal
.symtab
);
530 if (filename
== NULL
)
533 sprintf (buf
, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s} {%s} %d %d",
534 action
, b
->number
, (long)b
->address
, b
->line_number
, filename
,
535 bpdisp
[b
->disposition
], b
->enable
, b
->thread
);
537 v
= Tcl_Eval (gdbtk_interp
, buf
);
541 gdbtk_fputs (Tcl_GetStringResult (gdbtk_interp
), gdb_stdout
);
542 gdbtk_fputs ("\n", gdb_stdout
);
547 gdbtk_load_hash (section
, num
)
552 sprintf (buf
, "download_hash %s %ld", section
, num
);
553 Tcl_Eval (gdbtk_interp
, buf
);
554 return atoi (gdbtk_interp
->result
);
558 /* This hook is called whenever we are ready to load a symbol file so that
559 the UI can notify the user... */
561 gdbtk_pre_add_symbol (name
)
565 gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name
);
569 /* This hook is called whenever we finish loading a symbol file. */
571 gdbtk_post_add_symbol ()
573 Tcl_Eval (gdbtk_interp
, "gdbtk_tcl_post_add_symbol");
576 /* This hook function is called whenever we want to wait for the
580 gdbtk_wait (pid
, ourstatus
)
582 struct target_waitstatus
*ourstatus
;
584 /* Don't run the timer on various targets... */
585 if (!STREQ (target_shortname
, "ice"))
586 gdbtk_start_timer ();
587 pid
= target_wait (pid
, ourstatus
);
593 * This handles all queries from gdb.
594 * The first argument is a printf style format statement, the rest are its
595 * arguments. The resultant formatted string is passed to the Tcl function
597 * It returns the users response to the query, as well as putting the value
598 * in the result field of the Tcl interpreter.
602 gdbtk_query (query
, args
)
609 vsprintf (buf
, query
, args
);
610 gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf
);
612 val
= atol (gdbtk_interp
->result
);
618 gdbtk_print_frame_info (s
, line
, stopline
, noerror
)
624 current_source_symtab
= s
;
625 current_source_line
= line
;
629 gdbtk_create_tracepoint (tp
)
630 struct tracepoint
*tp
;
632 tracepoint_notify (tp
, "create");
636 gdbtk_delete_tracepoint (tp
)
637 struct tracepoint
*tp
;
639 tracepoint_notify (tp
, "delete");
643 gdbtk_modify_tracepoint (tp
)
644 struct tracepoint
*tp
;
646 tracepoint_notify (tp
, "modify");
650 tracepoint_notify(tp
, action
)
651 struct tracepoint
*tp
;
656 struct symtab_and_line sal
;
659 /* We ensure that ACTION contains no special Tcl characters, so we
661 sal
= find_pc_line (tp
->address
, 0);
663 filename
= symtab_to_filename (sal
.symtab
);
664 if (filename
== NULL
)
666 sprintf (buf
, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s} %d", action
, tp
->number
,
667 (long)tp
->address
, sal
.line
, filename
, tp
->pass_count
);
669 v
= Tcl_Eval (gdbtk_interp
, buf
);
673 gdbtk_fputs (gdbtk_interp
->result
, gdb_stdout
);
674 gdbtk_fputs ("\n", gdb_stdout
);
681 * This is run by the trace_find_command. arg is the argument that was passed
682 * to that command, from_tty is 1 if the command was run from a tty, 0 if it
683 * was run from a script. It runs gdbtk_tcl_tfind_hook passing on these two
689 gdbtk_trace_find (arg
, from_tty
)
696 Tcl_GlobalEval (gdbtk_interp
, "debug {*** In gdbtk_trace_find, from_tty is true}");
697 cmdObj
= Tcl_NewListObj (0, NULL
);
698 Tcl_ListObjAppendElement (gdbtk_interp
, cmdObj
,
699 Tcl_NewStringObj ("gdbtk_tcl_trace_find_hook", -1));
700 Tcl_ListObjAppendElement (gdbtk_interp
, cmdObj
, Tcl_NewStringObj (arg
, -1));
701 Tcl_ListObjAppendElement (gdbtk_interp
, cmdObj
, Tcl_NewIntObj(from_tty
));
702 Tcl_GlobalEvalObj (gdbtk_interp
, cmdObj
);
704 Tcl_GlobalEval (gdbtk_interp
, "debug {*** In gdbtk_trace_find, from_tty is false}");
709 * gdbtk_trace_start_stop
711 * This is run by the trace_start_command and trace_stop_command.
712 * The START variable determines which, 1 meaning trace_start was run,
713 * 0 meaning trace_stop was run.
718 gdbtk_trace_start_stop (start
, from_tty
)
725 Tcl_GlobalEval (gdbtk_interp
, "debug {*** In gdbtk_trace_start, from_tty is true}");
726 cmdObj
= Tcl_NewListObj (0, NULL
);
728 Tcl_ListObjAppendElement (gdbtk_interp
, cmdObj
,
729 Tcl_NewStringObj ("gdbtk_tcl_tstart", -1));
731 Tcl_ListObjAppendElement (gdbtk_interp
, cmdObj
,
732 Tcl_NewStringObj ("gdbtk_tcl_tstop", -1));
733 Tcl_GlobalEvalObj (gdbtk_interp
, cmdObj
);
735 Tcl_GlobalEval (gdbtk_interp
, "debug {*** In gdbtk_trace_startd, from_tty is false}");
741 gdbtk_selected_frame_changed (level
)
744 Tcl_UpdateLinkedVar (gdbtk_interp
, "gdb_selected_frame_level");
747 /* Called when the current thread changes. */
748 /* gdb_context is linked to the tcl variable "gdb_context_id" */
750 gdbtk_context_change (num
)
756 /* Called from file_command */
758 gdbtk_file_changed (filename
)
761 gdbtk_two_elem_cmd ("gdbtk_tcl_file_changed", filename
);
764 /* Called from exec_file_command */
766 gdbtk_exec_file_display (filename
)
769 gdbtk_two_elem_cmd ("gdbtk_tcl_exec_file_display", filename
);