1 /* Tcl/Tk interface routines.
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"
47 /* start-sanitize-ide */
51 /* end-sanitize-ide */
54 #ifdef ANSI_PROTOTYPES
64 #include <sys/ioctl.h>
65 #include "gdb_string.h"
74 #define GDBTK_PATH_SEP ";"
76 #define GDBTK_PATH_SEP ":"
79 /* Some versions (1.3.79, 1.3.81) of Linux don't support SIOCSPGRP the way
80 gdbtk wants to use it... */
85 static int No_Update
= 0;
86 static int load_in_progress
= 0;
87 static int in_fputs
= 0;
89 int gdbtk_load_hash
PARAMS ((char *, unsigned long));
90 int (*ui_load_progress_hook
) PARAMS ((char *, unsigned long));
91 void (*pre_add_symbol_hook
) PARAMS ((char *));
92 void (*post_add_symbol_hook
) PARAMS ((void));
95 extern void (*ui_loop_hook
) PARAMS ((int));
98 char * get_prompt
PARAMS ((void));
100 static void null_routine
PARAMS ((int));
101 static void gdbtk_flush
PARAMS ((FILE *));
102 static void gdbtk_fputs
PARAMS ((const char *, FILE *));
103 static int gdbtk_query
PARAMS ((const char *, va_list));
104 static void gdbtk_warning
PARAMS ((const char *, va_list));
105 static void gdbtk_ignorable_warning
PARAMS ((const char *));
106 static char *gdbtk_readline
PARAMS ((char *));
107 static void gdbtk_init
PARAMS ((char *));
108 static void tk_command_loop
PARAMS ((void));
109 static void gdbtk_call_command
PARAMS ((struct cmd_list_element
*, char *, int));
110 static int gdbtk_wait
PARAMS ((int, struct target_waitstatus
*));
111 static void x_event
PARAMS ((int));
112 static void gdbtk_interactive
PARAMS ((void));
113 static void cleanup_init
PARAMS ((int));
114 static void tk_command
PARAMS ((char *, int));
115 static int gdb_disassemble
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
116 static int compare_lines
PARAMS ((const PTR
, const PTR
));
117 static int gdbtk_dis_asm_read_memory
PARAMS ((bfd_vma
, bfd_byte
*, int, disassemble_info
*));
118 static int gdb_path_conv
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
119 static int gdb_stop
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
120 static int gdb_confirm_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
121 static int gdb_force_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
122 static int gdb_listfiles
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
123 static int gdb_listfuncs
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
124 static int call_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
125 static int call_obj_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
126 static int gdb_cmd
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
127 static int gdb_immediate_command
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
128 static int gdb_fetch_registers
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
129 static void gdbtk_readline_end
PARAMS ((void));
130 static void pc_changed
PARAMS ((void));
131 static int gdb_changed_register_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
132 static void register_changed_p
PARAMS ((int, void *));
133 static int gdb_get_breakpoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
134 static int gdb_get_breakpoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
135 static void breakpoint_notify
PARAMS ((struct breakpoint
*, const char *));
136 static void gdbtk_create_breakpoint
PARAMS ((struct breakpoint
*));
137 static void gdbtk_delete_breakpoint
PARAMS ((struct breakpoint
*));
138 static void gdbtk_modify_breakpoint
PARAMS ((struct breakpoint
*));
139 static int gdb_loc
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
140 static int gdb_eval
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
141 static int map_arg_registers
PARAMS ((int, char *[], void (*) (int, void *), void *));
142 static void get_register_name
PARAMS ((int, void *));
143 static int gdb_regnames
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
144 static void get_register
PARAMS ((int, void *));
145 static int gdb_trace_status
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
146 static int gdb_target_has_execution_command
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
147 static int gdb_load_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
148 void TclDebug
PARAMS ((const char *fmt
, ...));
149 static int gdb_get_locals_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
151 static int gdb_get_args_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
153 static int gdb_get_vars_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
154 static int gdb_get_function_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
155 static int gdb_get_line_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
156 static int gdb_get_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
157 static int gdb_tracepoint_exists_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
158 static int gdb_get_tracepoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
159 static int gdb_actions_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
160 static int gdb_prompt_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
161 static int gdb_find_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
162 static int gdb_get_tracepoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
163 static void gdbtk_create_tracepoint
PARAMS ((struct tracepoint
*));
164 static void gdbtk_delete_tracepoint
PARAMS ((struct tracepoint
*));
165 static void gdbtk_modify_tracepoint
PARAMS ((struct tracepoint
*));
166 static void tracepoint_notify
PARAMS ((struct tracepoint
*, const char *));
167 static void gdbtk_print_frame_info
PARAMS ((struct symtab
*, int, int, int));
168 void gdbtk_pre_add_symbol
PARAMS ((char *));
169 void gdbtk_post_add_symbol
PARAMS ((void));
170 static int get_pc_register
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
171 static int gdb_loadfile
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
172 static int gdb_set_bp
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
173 static struct symtab
*full_lookup_symtab
PARAMS ((char *file
));
174 static int gdb_get_mem
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
176 /* Handle for TCL interpreter */
177 static Tcl_Interp
*interp
= NULL
;
179 static int gdbtk_timer_going
= 0;
180 static void gdbtk_start_timer
PARAMS ((void));
181 static void gdbtk_stop_timer
PARAMS ((void));
183 /* This variable is true when the inferior is running. Although it's
184 possible to disable most input from widgets and thus prevent
185 attempts to do anything while the inferior is running, any commands
186 that get through - even a simple memory read - are Very Bad, and
187 may cause GDB to crash or behave strangely. So, this variable
188 provides an extra layer of defense. */
190 static int running_now
;
192 /* This variable determines where memory used for disassembly is read from.
193 If > 0, then disassembly comes from the exec file rather than the
194 target (which might be at the other end of a slow serial link). If
195 == 0 then disassembly comes from target. If < 0 disassembly is
196 automatically switched to the target if it's an inferior process,
197 otherwise the exec file is used. */
199 static int disassemble_from_exec
= -1;
203 /* Supply malloc calls for tcl/tk. We do not want to do this on
204 Windows, because Tcl_Alloc is probably in a DLL which will not call
205 the mmalloc routines. */
211 return xmalloc (size
);
215 Tcl_Realloc (ptr
, size
)
219 return xrealloc (ptr
, size
);
229 #endif /* ! _WIN32 */
239 /* On Windows, if we hold a file open, other programs can't write to
240 it. In particular, we don't want to hold the executable open,
241 because it will mean that people have to get out of the debugging
242 session in order to remake their program. So we close it, although
243 this will cost us if and when we need to reopen it. */
253 bfd_cache_close (o
->obfd
);
256 if (exec_bfd
!= NULL
)
257 bfd_cache_close (exec_bfd
);
262 /* The following routines deal with stdout/stderr data, which is created by
263 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
264 lowest level of these routines and capture all output from the rest of GDB.
265 Normally they present their data to tcl via callbacks to the following tcl
266 routines: gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush. These
267 in turn call tk routines to update the display.
269 Under some circumstances, you may want to collect the output so that it can
270 be returned as the value of a tcl procedure. This can be done by
271 surrounding the output routines with calls to start_saving_output and
272 finish_saving_output. The saved data can then be retrieved with
273 get_saved_output (but this must be done before the call to
274 finish_saving_output). */
276 /* Dynamic string for output. */
278 static Tcl_DString
*result_ptr
;
280 /* Dynamic string for stderr. This is only used if result_ptr is
283 static Tcl_DString
*error_string_ptr
;
290 /* Force immediate screen update */
292 Tcl_VarEval (interp
, "gdbtk_tcl_flush", NULL
);
297 gdbtk_fputs (ptr
, stream
)
301 char *merge
[2], *command
;
305 Tcl_DStringAppend (result_ptr
, (char *) ptr
, -1);
306 else if (error_string_ptr
!= NULL
&& stream
== gdb_stderr
)
307 Tcl_DStringAppend (error_string_ptr
, (char *) ptr
, -1);
310 merge
[0] = "gdbtk_tcl_fputs";
311 merge
[1] = (char *)ptr
;
312 command
= Tcl_Merge (2, merge
);
313 Tcl_Eval (interp
, command
);
320 gdbtk_warning (warning
, args
)
324 char buf
[200], *merge
[2];
327 vsprintf (buf
, warning
, args
);
328 merge
[0] = "gdbtk_tcl_warning";
330 command
= Tcl_Merge (2, merge
);
331 Tcl_Eval (interp
, command
);
336 gdbtk_ignorable_warning (warning
)
339 char buf
[200], *merge
[2];
342 sprintf (buf
, warning
);
343 merge
[0] = "gdbtk_tcl_ignorable_warning";
345 command
= Tcl_Merge (2, merge
);
346 Tcl_Eval (interp
, command
);
351 gdbtk_query (query
, args
)
355 char buf
[200], *merge
[2];
359 vsprintf (buf
, query
, args
);
360 merge
[0] = "gdbtk_tcl_query";
362 command
= Tcl_Merge (2, merge
);
363 Tcl_Eval (interp
, command
);
366 val
= atol (interp
->result
);
372 #ifdef ANSI_PROTOTYPES
373 gdbtk_readline_begin (char *format
, ...)
375 gdbtk_readline_begin (va_alist
)
380 char buf
[200], *merge
[2];
383 #ifdef ANSI_PROTOTYPES
384 va_start (args
, format
);
388 format
= va_arg (args
, char *);
391 vsprintf (buf
, format
, args
);
392 merge
[0] = "gdbtk_tcl_readline_begin";
394 command
= Tcl_Merge (2, merge
);
395 Tcl_Eval (interp
, command
);
400 gdbtk_readline (prompt
)
411 merge
[0] = "gdbtk_tcl_readline";
413 command
= Tcl_Merge (2, merge
);
414 result
= Tcl_Eval (interp
, command
);
416 if (result
== TCL_OK
)
418 return (strdup (interp
-> result
));
422 gdbtk_fputs (interp
-> result
, gdb_stdout
);
423 gdbtk_fputs ("\n", gdb_stdout
);
429 gdbtk_readline_end ()
431 Tcl_Eval (interp
, "gdbtk_tcl_readline_end");
437 Tcl_Eval (interp
, "gdbtk_pc_changed");
442 #ifdef ANSI_PROTOTYPES
443 dsprintf_append_element (Tcl_DString
*dsp
, char *format
, ...)
445 dsprintf_append_element (va_alist
)
452 #ifdef ANSI_PROTOTYPES
453 va_start (args
, format
);
459 dsp
= va_arg (args
, Tcl_DString
*);
460 format
= va_arg (args
, char *);
463 vsprintf (buf
, format
, args
);
465 Tcl_DStringAppendElement (dsp
, buf
);
469 gdb_path_conv (clientData
, interp
, argc
, argv
)
470 ClientData clientData
;
476 char pathname
[256], *ptr
;
478 error ("wrong # args");
479 cygwin32_conv_to_full_win32_path (argv
[1], pathname
);
480 for (ptr
= pathname
; *ptr
; ptr
++)
486 char *pathname
= argv
[1];
488 Tcl_DStringAppend (result_ptr
, pathname
, strlen(pathname
));
493 gdb_get_breakpoint_list (clientData
, interp
, argc
, argv
)
494 ClientData clientData
;
499 struct breakpoint
*b
;
500 extern struct breakpoint
*breakpoint_chain
;
503 error ("wrong # args");
505 for (b
= breakpoint_chain
; b
; b
= b
->next
)
506 if (b
->type
== bp_breakpoint
)
507 dsprintf_append_element (result_ptr
, "%d", b
->number
);
513 gdb_get_breakpoint_info (clientData
, interp
, argc
, argv
)
514 ClientData clientData
;
519 struct symtab_and_line sal
;
520 static char *bptypes
[] = {"breakpoint", "hardware breakpoint", "until",
521 "finish", "watchpoint", "hardware watchpoint",
522 "read watchpoint", "access watchpoint",
523 "longjmp", "longjmp resume", "step resume",
524 "through sigtramp", "watchpoint scope",
526 static char *bpdisp
[] = {"delete", "delstop", "disable", "donttouch"};
527 struct command_line
*cmd
;
529 struct breakpoint
*b
;
530 extern struct breakpoint
*breakpoint_chain
;
531 char *funcname
, *fname
, *filename
;
534 error ("wrong # args");
536 bpnum
= atoi (argv
[1]);
538 for (b
= breakpoint_chain
; b
; b
= b
->next
)
539 if (b
->number
== bpnum
)
542 if (!b
|| b
->type
!= bp_breakpoint
)
543 error ("Breakpoint #%d does not exist", bpnum
);
545 sal
= find_pc_line (b
->address
, 0);
547 filename
= symtab_to_filename (sal
.symtab
);
548 if (filename
== NULL
)
550 Tcl_DStringAppendElement (result_ptr
, filename
);
552 find_pc_partial_function (b
->address
, &funcname
, NULL
, NULL
);
553 fname
= cplus_demangle (funcname
, 0);
556 Tcl_DStringAppendElement (result_ptr
, fname
);
560 Tcl_DStringAppendElement (result_ptr
, funcname
);
561 dsprintf_append_element (result_ptr
, "%d", b
->line_number
);
562 dsprintf_append_element (result_ptr
, "0x%lx", b
->address
);
563 Tcl_DStringAppendElement (result_ptr
, bptypes
[b
->type
]);
564 Tcl_DStringAppendElement (result_ptr
, b
->enable
== enabled
? "1" : "0");
565 Tcl_DStringAppendElement (result_ptr
, bpdisp
[b
->disposition
]);
566 dsprintf_append_element (result_ptr
, "%d", b
->ignore_count
);
568 Tcl_DStringStartSublist (result_ptr
);
569 for (cmd
= b
->commands
; cmd
; cmd
= cmd
->next
)
570 Tcl_DStringAppendElement (result_ptr
, cmd
->line
);
571 Tcl_DStringEndSublist (result_ptr
);
573 Tcl_DStringAppendElement (result_ptr
, b
->cond_string
);
575 dsprintf_append_element (result_ptr
, "%d", b
->thread
);
576 dsprintf_append_element (result_ptr
, "%d", b
->hit_count
);
582 breakpoint_notify(b
, action
)
583 struct breakpoint
*b
;
588 struct symtab_and_line sal
;
591 if (b
->type
!= bp_breakpoint
)
594 /* We ensure that ACTION contains no special Tcl characters, so we
596 sal
= find_pc_line (b
->address
, 0);
597 filename
= symtab_to_filename (sal
.symtab
);
598 if (filename
== NULL
)
601 sprintf (buf
, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action
, b
->number
,
602 (long)b
->address
, b
->line_number
, filename
);
604 v
= Tcl_Eval (interp
, buf
);
608 gdbtk_fputs (interp
->result
, gdb_stdout
);
609 gdbtk_fputs ("\n", gdb_stdout
);
614 gdbtk_create_breakpoint(b
)
615 struct breakpoint
*b
;
617 breakpoint_notify (b
, "create");
621 gdbtk_delete_breakpoint(b
)
622 struct breakpoint
*b
;
624 breakpoint_notify (b
, "delete");
628 gdbtk_modify_breakpoint(b
)
629 struct breakpoint
*b
;
631 breakpoint_notify (b
, "modify");
634 /* This implements the TCL command `gdb_loc', which returns a list */
635 /* consisting of the following: */
636 /* basename, function name, filename, line number, address, current pc */
639 gdb_loc (clientData
, interp
, argc
, argv
)
640 ClientData clientData
;
646 struct symtab_and_line sal
;
647 char *funcname
, *fname
;
650 if (!have_full_symbols () && !have_partial_symbols ())
652 Tcl_SetResult (interp
, "No symbol table is loaded", TCL_STATIC
);
658 if (selected_frame
&& (selected_frame
->pc
!= stop_pc
))
660 /* Note - this next line is not correct on all architectures. */
661 /* For a graphical debugged we really want to highlight the */
662 /* assembly line that called the next function on the stack. */
663 /* Many architectures have the next instruction saved as the */
664 /* pc on the stack, so what happens is the next instruction is hughlighted. */
666 pc
= selected_frame
->pc
;
667 sal
= find_pc_line (selected_frame
->pc
,
668 selected_frame
->next
!= NULL
669 && !selected_frame
->next
->signal_handler_caller
670 && !frame_in_dummy (selected_frame
->next
));
675 sal
= find_pc_line (stop_pc
, 0);
680 struct symtabs_and_lines sals
;
683 sals
= decode_line_spec (argv
[1], 1);
690 error ("Ambiguous line spec");
695 error ("wrong # args");
698 Tcl_DStringAppendElement (result_ptr
, sal
.symtab
->filename
);
700 Tcl_DStringAppendElement (result_ptr
, "");
702 find_pc_partial_function (pc
, &funcname
, NULL
, NULL
);
703 fname
= cplus_demangle (funcname
, 0);
706 Tcl_DStringAppendElement (result_ptr
, fname
);
710 Tcl_DStringAppendElement (result_ptr
, funcname
);
711 filename
= symtab_to_filename (sal
.symtab
);
712 if (filename
== NULL
)
715 Tcl_DStringAppendElement (result_ptr
, filename
);
716 dsprintf_append_element (result_ptr
, "%d", sal
.line
); /* line number */
717 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(pc
)); /* PC in current frame */
718 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(stop_pc
)); /* Real PC */
722 /* This implements the TCL command `gdb_eval'. */
725 gdb_eval (clientData
, interp
, argc
, argv
)
726 ClientData clientData
;
731 struct expression
*expr
;
732 struct cleanup
*old_chain
;
736 error ("wrong # args");
738 expr
= parse_expression (argv
[1]);
740 old_chain
= make_cleanup (free_current_contents
, &expr
);
742 val
= evaluate_expression (expr
);
744 val_print (VALUE_TYPE (val
), VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
745 gdb_stdout
, 0, 0, 0, 0);
747 do_cleanups (old_chain
);
752 /* gdb_get_mem addr form size num aschar*/
753 /* dump a block of memory */
754 /* addr: address of data to dump */
755 /* form: a char indicating format */
756 /* size: size of each element; 1,2,4, or 8 bytes*/
757 /* num: the number of bytes to read */
758 /* acshar: an optional ascii character to use in ASCII dump */
759 /* returns a list of elements followed by an optional */
763 gdb_get_mem (clientData
, interp
, argc
, argv
)
764 ClientData clientData
;
769 int size
, asize
, i
, j
, bc
;
771 int nbytes
, rnum
, bpr
;
772 char format
, c
, *ptr
, buff
[128], aschar
, *mbuf
, *mptr
, *cptr
, *bptr
;
773 struct type
*val_type
;
775 if (argc
< 6 || argc
> 7)
777 interp
->result
= "addr format size bytes bytes_per_row ?ascii_char?";
781 size
= (int)strtoul(argv
[3],(char **)NULL
,0);
782 nbytes
= (int)strtoul(argv
[4],(char **)NULL
,0);
783 bpr
= (int)strtoul(argv
[5],(char **)NULL
,0);
784 if (nbytes
<= 0 || bpr
<= 0 || size
<= 0)
786 interp
->result
= "Invalid number of bytes.";
790 addr
= (CORE_ADDR
)strtoul(argv
[1],(char **)NULL
,0);
792 mbuf
= (char *)malloc (nbytes
+32);
795 interp
->result
= "Out of memory.";
798 memset (mbuf
, 0, nbytes
+32);
801 rnum
= target_read_memory_partial (addr
, mbuf
, nbytes
, NULL
);
810 val_type
= builtin_type_char
;
814 val_type
= builtin_type_short
;
818 val_type
= builtin_type_int
;
822 val_type
= builtin_type_long_long
;
826 val_type
= builtin_type_char
;
830 bc
= 0; /* count of bytes in a row */
831 buff
[0] = '"'; /* buffer for ascii dump */
832 bptr
= &buff
[1]; /* pointer for ascii dump */
834 for (i
=0; i
< nbytes
; i
+= size
)
838 fputs_unfiltered ("N/A ", gdb_stdout
);
840 for ( j
= 0; j
< size
; j
++)
845 print_scalar_formatted (mptr
, val_type
, format
, asize
, gdb_stdout
);
846 fputs_unfiltered (" ", gdb_stdout
);
849 for ( j
= 0; j
< size
; j
++)
852 if (c
< 32 || c
> 126)
864 if (aschar
&& (bc
>= bpr
))
866 /* end of row. print it and reset variables */
871 fputs_unfiltered (buff
, gdb_stdout
);
881 map_arg_registers (argc
, argv
, func
, argp
)
884 void (*func
) PARAMS ((int regnum
, void *argp
));
889 /* Note that the test for a valid register must include checking the
890 reg_names array because NUM_REGS may be allocated for the union of the
891 register sets within a family of related processors. In this case, the
892 trailing entries of reg_names will change depending upon the particular
893 processor being debugged. */
895 if (argc
== 0) /* No args, just do all the regs */
899 && reg_names
[regnum
] != NULL
900 && *reg_names
[regnum
] != '\000';
907 /* Else, list of register #s, just do listed regs */
908 for (; argc
> 0; argc
--, argv
++)
910 regnum
= atoi (*argv
);
914 && reg_names
[regnum
] != NULL
915 && *reg_names
[regnum
] != '\000')
918 error ("bad register number");
925 get_register_name (regnum
, argp
)
927 void *argp
; /* Ignored */
929 Tcl_DStringAppendElement (result_ptr
, reg_names
[regnum
]);
932 /* This implements the TCL command `gdb_regnames', which returns a list of
933 all of the register names. */
936 gdb_regnames (clientData
, interp
, argc
, argv
)
937 ClientData clientData
;
945 return map_arg_registers (argc
, argv
, get_register_name
, NULL
);
948 #ifndef REGISTER_CONVERTIBLE
949 #define REGISTER_CONVERTIBLE(x) (0 != 0)
952 #ifndef REGISTER_CONVERT_TO_VIRTUAL
953 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
956 #ifndef INVALID_FLOAT
957 #define INVALID_FLOAT(x, y) (0 != 0)
961 get_register (regnum
, fp
)
965 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
966 char virtual_buffer
[MAX_REGISTER_VIRTUAL_SIZE
];
967 int format
= (int)fp
;
972 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
974 Tcl_DStringAppendElement (result_ptr
, "Optimized out");
978 /* Convert raw data to virtual format if necessary. */
980 if (REGISTER_CONVERTIBLE (regnum
))
982 REGISTER_CONVERT_TO_VIRTUAL (regnum
, REGISTER_VIRTUAL_TYPE (regnum
),
983 raw_buffer
, virtual_buffer
);
986 memcpy (virtual_buffer
, raw_buffer
, REGISTER_VIRTUAL_SIZE (regnum
));
991 printf_filtered ("0x");
992 for (j
= 0; j
< REGISTER_RAW_SIZE (regnum
); j
++)
994 register int idx
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? j
995 : REGISTER_RAW_SIZE (regnum
) - 1 - j
;
996 printf_filtered ("%02x", (unsigned char)raw_buffer
[idx
]);
1000 val_print (REGISTER_VIRTUAL_TYPE (regnum
), virtual_buffer
, 0,
1001 gdb_stdout
, format
, 1, 0, Val_pretty_default
);
1003 Tcl_DStringAppend (result_ptr
, " ", -1);
1007 get_pc_register (clientData
, interp
, argc
, argv
)
1008 ClientData clientData
;
1013 sprintf(interp
->result
,"0x%llx",(long long)read_register(PC_REGNUM
));
1018 gdb_fetch_registers (clientData
, interp
, argc
, argv
)
1019 ClientData clientData
;
1027 error ("wrong # args");
1033 return map_arg_registers (argc
, argv
, get_register
, (void *) format
);
1036 /* This contains the previous values of the registers, since the last call to
1037 gdb_changed_register_list. */
1039 static char old_regs
[REGISTER_BYTES
];
1042 register_changed_p (regnum
, argp
)
1044 void *argp
; /* Ignored */
1046 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
1048 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
1051 if (memcmp (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1052 REGISTER_RAW_SIZE (regnum
)) == 0)
1055 /* Found a changed register. Save new value and return its number. */
1057 memcpy (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1058 REGISTER_RAW_SIZE (regnum
));
1060 dsprintf_append_element (result_ptr
, "%d", regnum
);
1064 gdb_changed_register_list (clientData
, interp
, argc
, argv
)
1065 ClientData clientData
;
1073 return map_arg_registers (argc
, argv
, register_changed_p
, NULL
);
1076 /* This implements the tcl command "gdb_immediate", which does exactly
1077 the same thing as gdb_cmd, except NONE of its outut is buffered. */
1078 /* This will also ALWAYS cause the busy,update, and idle hooks to be
1079 called, contrasted with gdb_cmd, which NEVER calls them. */
1081 gdb_immediate_command (clientData
, interp
, argc
, argv
)
1082 ClientData clientData
;
1087 Tcl_DString
*save_ptr
= NULL
;
1090 error ("wrong # args");
1092 if (running_now
|| load_in_progress
)
1097 Tcl_DStringAppend (result_ptr
, "", -1);
1098 save_ptr
= result_ptr
;
1101 execute_command (argv
[1], 1);
1103 bpstat_do_actions (&stop_bpstat
);
1105 result_ptr
= save_ptr
;
1110 /* This implements the TCL command `gdb_cmd', which sends its argument into
1111 the GDB command scanner. */
1112 /* This command will never cause the update, idle and busy hooks to be called
1115 gdb_cmd (clientData
, interp
, argc
, argv
)
1116 ClientData clientData
;
1121 Tcl_DString
*save_ptr
= NULL
;
1124 error ("wrong # args");
1126 if (running_now
|| load_in_progress
)
1131 /* for the load instruction (and possibly others later) we
1132 set result_ptr to NULL so gdbtk_fputs() will not buffer
1133 all the data until the command is finished. */
1135 if (strncmp ("load ", argv
[1], 5) == 0
1136 || strncmp ("while ", argv
[1], 6) == 0)
1138 Tcl_DStringAppend (result_ptr
, "", -1);
1139 save_ptr
= result_ptr
;
1141 load_in_progress
= 1;
1142 gdbtk_start_timer ();
1145 execute_command (argv
[1], 1);
1147 if (load_in_progress
)
1149 gdbtk_stop_timer ();
1150 load_in_progress
= 0;
1153 bpstat_do_actions (&stop_bpstat
);
1156 result_ptr
= save_ptr
;
1161 /* Client of call_wrapper - this routine performs the actual call to
1162 the client function. */
1164 struct wrapped_call_args
1175 struct wrapped_call_args
*args
;
1177 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->argc
, args
->argv
);
1181 struct wrapped_call_objs
1191 wrapped_obj_call (args
)
1192 struct wrapped_call_objs
*args
;
1194 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->objc
, args
->objv
);
1198 /* This routine acts as a top-level for all GDB code called by tcl/Tk. It
1199 handles cleanups, and calls to return_to_top_level (usually via error).
1200 This is necessary in order to prevent a longjmp out of the bowels of Tk,
1201 possibly leaving things in a bad state. Since this routine can be called
1202 recursively, it needs to save and restore the contents of the jmp_buf as
1206 call_wrapper (clientData
, interp
, argc
, argv
)
1207 ClientData clientData
;
1212 struct wrapped_call_args wrapped_args
;
1213 Tcl_DString result
, *old_result_ptr
;
1214 Tcl_DString error_string
, *old_error_string_ptr
;
1216 Tcl_DStringInit (&result
);
1217 old_result_ptr
= result_ptr
;
1218 result_ptr
= &result
;
1220 Tcl_DStringInit (&error_string
);
1221 old_error_string_ptr
= error_string_ptr
;
1222 error_string_ptr
= &error_string
;
1224 wrapped_args
.func
= (Tcl_CmdProc
*)clientData
;
1225 wrapped_args
.interp
= interp
;
1226 wrapped_args
.argc
= argc
;
1227 wrapped_args
.argv
= argv
;
1228 wrapped_args
.val
= 0;
1230 if (!catch_errors (wrapped_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
1232 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
1234 /* Make sure the timer interrupts are turned off. */
1235 if (gdbtk_timer_going
)
1236 gdbtk_stop_timer ();
1238 gdb_flush (gdb_stderr
); /* Flush error output */
1239 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
1241 /* In case of an error, we may need to force the GUI into idle
1242 mode because gdbtk_call_command may have bombed out while in
1243 the command routine. */
1246 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1249 /* do not suppress any errors -- a remote target could have errored */
1250 load_in_progress
= 0;
1252 if (Tcl_DStringLength (&error_string
) == 0)
1254 Tcl_DStringResult (interp
, &result
);
1255 Tcl_DStringFree (&error_string
);
1257 else if (Tcl_DStringLength (&result
) == 0)
1259 Tcl_DStringResult (interp
, &error_string
);
1260 Tcl_DStringFree (&result
);
1261 Tcl_DStringFree (&error_string
);
1265 Tcl_ResetResult (interp
);
1266 Tcl_AppendResult (interp
, Tcl_DStringValue (&result
),
1267 Tcl_DStringValue (&error_string
), (char *) NULL
);
1268 Tcl_DStringFree (&result
);
1269 Tcl_DStringFree (&error_string
);
1272 result_ptr
= old_result_ptr
;
1273 error_string_ptr
= old_error_string_ptr
;
1279 return wrapped_args
.val
;
1282 call_obj_wrapper (clientData
, interp
, objc
, objv
)
1283 ClientData clientData
;
1286 Tcl_Obj
*CONST objv
[];
1288 struct wrapped_call_objs wrapped_args
;
1289 Tcl_DString result
, *old_result_ptr
;
1290 Tcl_DString error_string
, *old_error_string_ptr
;
1292 /* The obj call wrapper works differently from the string wrapper, because
1293 * the obj calls currently insert their results directly into the
1294 * interpreter's result. So there is no need to have a result_ptr...
1295 * FIXME - rewrite all the object commands so they use a result_obj_ptr
1296 * - rewrite all the string commands to be object commands.
1299 Tcl_DStringInit (&result
);
1300 old_result_ptr
= result_ptr
;
1301 result_ptr
= &result
;
1303 Tcl_DStringInit (&error_string
);
1305 Tcl_DStringInit (&error_string
);
1306 old_error_string_ptr
= error_string_ptr
;
1307 error_string_ptr
= &error_string
;
1309 wrapped_args
.func
= (Tcl_CmdProc
*)clientData
;
1310 wrapped_args
.interp
= interp
;
1311 wrapped_args
.objc
= objc
;
1312 wrapped_args
.objv
= objv
;
1313 wrapped_args
.val
= 0;
1315 if (!catch_errors (wrapped_obj_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
1317 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
1319 /* Make sure the timer interrupts are turned off. */
1320 if (gdbtk_timer_going
)
1321 gdbtk_stop_timer ();
1323 gdb_flush (gdb_stderr
); /* Flush error output */
1324 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
1326 /* In case of an error, we may need to force the GUI into idle
1327 mode because gdbtk_call_command may have bombed out while in
1328 the command routine. */
1331 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1334 /* do not suppress any errors -- a remote target could have errored */
1335 load_in_progress
= 0;
1337 if (Tcl_DStringLength (&error_string
) == 0)
1339 /* We should insert the result here, but the obj commands now
1340 * do this directly, so we don't need to.
1341 * FIXME - ultimately, all this should be redone so that all the
1342 * commands either manipulate the Tcl result directly, or use a result_ptr.
1345 Tcl_DStringFree (&error_string
);
1347 else if (*(Tcl_GetStringResult (interp
)) == '\0')
1349 Tcl_DStringResult (interp
, &error_string
);
1350 Tcl_DStringFree (&error_string
);
1354 Tcl_AppendToObj(Tcl_GetObjResult(interp
), Tcl_DStringValue (&error_string
),
1355 Tcl_DStringLength (&error_string
));
1356 Tcl_DStringFree (&error_string
);
1359 result_ptr
= old_result_ptr
;
1360 error_string_ptr
= old_error_string_ptr
;
1366 return wrapped_args
.val
;
1370 comp_files (file1
, file2
)
1371 const char *file1
[], *file2
[];
1373 return strcmp(*file1
,*file2
);
1377 gdb_listfiles (clientData
, interp
, objc
, objv
)
1378 ClientData clientData
;
1381 Tcl_Obj
*CONST objv
[];
1383 struct objfile
*objfile
;
1384 struct partial_symtab
*psymtab
;
1385 struct symtab
*symtab
;
1386 char *lastfile
, *pathname
, **files
;
1388 int i
, numfiles
= 0, len
= 0;
1392 files
= (char **) xmalloc (sizeof (char *) * files_size
);
1396 Tcl_WrongNumArgs (interp
, 1, objv
, "Usage: gdb_listfiles ?pathname?");
1400 pathname
= Tcl_GetStringFromObj (objv
[1], &len
);
1402 mylist
= Tcl_NewListObj (0, NULL
);
1404 ALL_PSYMTABS (objfile
, psymtab
)
1406 if (numfiles
== files_size
)
1408 files_size
= files_size
* 2;
1409 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1413 if (psymtab
->filename
)
1414 files
[numfiles
++] = basename(psymtab
->filename
);
1416 else if (!strcmp(psymtab
->filename
,basename(psymtab
->filename
))
1417 || !strncmp(pathname
,psymtab
->filename
,len
))
1418 if (psymtab
->filename
)
1419 files
[numfiles
++] = basename(psymtab
->filename
);
1422 ALL_SYMTABS (objfile
, symtab
)
1424 if (numfiles
== files_size
)
1426 files_size
= files_size
* 2;
1427 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1431 if (symtab
->filename
)
1432 files
[numfiles
++] = basename(symtab
->filename
);
1434 else if (!strcmp(symtab
->filename
,basename(symtab
->filename
))
1435 || !strncmp(pathname
,symtab
->filename
,len
))
1436 if (symtab
->filename
)
1437 files
[numfiles
++] = basename(symtab
->filename
);
1440 qsort (files
, numfiles
, sizeof(char *), comp_files
);
1443 for (i
= 0; i
< numfiles
; i
++)
1445 if (strcmp(files
[i
],lastfile
))
1446 Tcl_ListObjAppendElement (interp
, mylist
, Tcl_NewStringObj(files
[i
], -1));
1447 lastfile
= files
[i
];
1449 Tcl_SetObjResult (interp
, mylist
);
1455 gdb_listfuncs (clientData
, interp
, argc
, argv
)
1456 ClientData clientData
;
1461 struct symtab
*symtab
;
1462 struct blockvector
*bv
;
1469 error ("wrong # args");
1471 symtab
= full_lookup_symtab (argv
[1]);
1473 error ("No such file");
1475 bv
= BLOCKVECTOR (symtab
);
1476 for (i
= GLOBAL_BLOCK
; i
<= STATIC_BLOCK
; i
++)
1478 b
= BLOCKVECTOR_BLOCK (bv
, i
);
1479 /* Skip the sort if this block is always sorted. */
1480 if (!BLOCK_SHOULD_SORT (b
))
1481 sort_block_syms (b
);
1482 for (j
= 0; j
< BLOCK_NSYMS (b
); j
++)
1484 sym
= BLOCK_SYM (b
, j
);
1485 if (SYMBOL_CLASS (sym
) == LOC_BLOCK
)
1488 char *name
= cplus_demangle (SYMBOL_NAME(sym
), 0);
1491 sprintf (buf
,"{%s} 1", name
);
1494 sprintf (buf
,"{%s} 0", SYMBOL_NAME(sym
));
1495 Tcl_DStringAppendElement (result_ptr
, buf
);
1503 target_stop_wrapper (args
)
1511 gdb_stop (clientData
, interp
, argc
, argv
)
1512 ClientData clientData
;
1519 catch_errors (target_stop_wrapper
, NULL
, "",
1523 quit_flag
= 1; /* hope something sees this */
1528 /* Prepare to accept a new executable file. This is called when we
1529 want to clear away everything we know about the old file, without
1530 asking the user. The Tcl code will have already asked the user if
1531 necessary. After this is called, we should be able to run the
1532 `file' command without getting any questions. */
1535 gdb_clear_file (clientData
, interp
, argc
, argv
)
1536 ClientData clientData
;
1541 if (inferior_pid
!= 0 && target_has_execution
)
1544 target_detach (NULL
, 0);
1549 if (target_has_execution
)
1552 symbol_file_command (NULL
, 0);
1554 /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
1555 clear it here. FIXME: This seems like an abstraction violation
1562 /* Ask the user to confirm an exit request. */
1565 gdb_confirm_quit (clientData
, interp
, argc
, argv
)
1566 ClientData clientData
;
1573 ret
= quit_confirm ();
1574 Tcl_DStringAppendElement (result_ptr
, ret
? "1" : "0");
1578 /* Quit without asking for confirmation. */
1581 gdb_force_quit (clientData
, interp
, argc
, argv
)
1582 ClientData clientData
;
1587 quit_force ((char *) NULL
, 1);
1591 /* This implements the TCL command `gdb_disassemble'. */
1594 gdbtk_dis_asm_read_memory (memaddr
, myaddr
, len
, info
)
1598 disassemble_info
*info
;
1600 extern struct target_ops exec_ops
;
1604 res
= xfer_memory (memaddr
, myaddr
, len
, 0, &exec_ops
);
1615 /* We need a different sort of line table from the normal one cuz we can't
1616 depend upon implicit line-end pc's for lines. This is because of the
1617 reordering we are about to do. */
1619 struct my_line_entry
{
1626 compare_lines (mle1p
, mle2p
)
1630 struct my_line_entry
*mle1
, *mle2
;
1633 mle1
= (struct my_line_entry
*) mle1p
;
1634 mle2
= (struct my_line_entry
*) mle2p
;
1636 val
= mle1
->line
- mle2
->line
;
1641 return mle1
->start_pc
- mle2
->start_pc
;
1645 gdb_disassemble (clientData
, interp
, argc
, argv
)
1646 ClientData clientData
;
1651 CORE_ADDR pc
, low
, high
;
1652 int mixed_source_and_assembly
;
1653 static disassemble_info di
;
1654 static int di_initialized
;
1656 if (! di_initialized
)
1658 INIT_DISASSEMBLE_INFO_NO_ARCH (di
, gdb_stdout
,
1659 (fprintf_ftype
) fprintf_unfiltered
);
1660 di
.flavour
= bfd_target_unknown_flavour
;
1661 di
.memory_error_func
= dis_asm_memory_error
;
1662 di
.print_address_func
= dis_asm_print_address
;
1666 di
.mach
= tm_print_insn_info
.mach
;
1667 if (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1668 di
.endian
= BFD_ENDIAN_BIG
;
1670 di
.endian
= BFD_ENDIAN_LITTLE
;
1672 if (argc
!= 3 && argc
!= 4)
1673 error ("wrong # args");
1675 if (strcmp (argv
[1], "source") == 0)
1676 mixed_source_and_assembly
= 1;
1677 else if (strcmp (argv
[1], "nosource") == 0)
1678 mixed_source_and_assembly
= 0;
1680 error ("First arg must be 'source' or 'nosource'");
1682 low
= parse_and_eval_address (argv
[2]);
1686 if (find_pc_partial_function (low
, NULL
, &low
, &high
) == 0)
1687 error ("No function contains specified address");
1690 high
= parse_and_eval_address (argv
[3]);
1692 /* If disassemble_from_exec == -1, then we use the following heuristic to
1693 determine whether or not to do disassembly from target memory or from the
1696 If we're debugging a local process, read target memory, instead of the
1697 exec file. This makes disassembly of functions in shared libs work
1700 Else, we're debugging a remote process, and should disassemble from the
1701 exec file for speed. However, this is no good if the target modifies its
1702 code (for relocation, or whatever).
1705 if (disassemble_from_exec
== -1)
1706 if (strcmp (target_shortname
, "child") == 0
1707 || strcmp (target_shortname
, "procfs") == 0
1708 || strcmp (target_shortname
, "vxprocess") == 0)
1709 disassemble_from_exec
= 0; /* It's a child process, read inferior mem */
1711 disassemble_from_exec
= 1; /* It's remote, read the exec file */
1713 if (disassemble_from_exec
)
1714 di
.read_memory_func
= gdbtk_dis_asm_read_memory
;
1716 di
.read_memory_func
= dis_asm_read_memory
;
1718 /* If just doing straight assembly, all we need to do is disassemble
1719 everything between low and high. If doing mixed source/assembly, we've
1720 got a totally different path to follow. */
1722 if (mixed_source_and_assembly
)
1723 { /* Come here for mixed source/assembly */
1724 /* The idea here is to present a source-O-centric view of a function to
1725 the user. This means that things are presented in source order, with
1726 (possibly) out of order assembly immediately following. */
1727 struct symtab
*symtab
;
1728 struct linetable_entry
*le
;
1731 struct my_line_entry
*mle
;
1732 struct symtab_and_line sal
;
1737 symtab
= find_pc_symtab (low
); /* Assume symtab is valid for whole PC range */
1742 /* First, convert the linetable to a bunch of my_line_entry's. */
1744 le
= symtab
->linetable
->item
;
1745 nlines
= symtab
->linetable
->nitems
;
1750 mle
= (struct my_line_entry
*) alloca (nlines
* sizeof (struct my_line_entry
));
1754 /* Copy linetable entries for this function into our data structure, creating
1755 end_pc's and setting out_of_order as appropriate. */
1757 /* First, skip all the preceding functions. */
1759 for (i
= 0; i
< nlines
- 1 && le
[i
].pc
< low
; i
++) ;
1761 /* Now, copy all entries before the end of this function. */
1764 for (; i
< nlines
- 1 && le
[i
].pc
< high
; i
++)
1766 if (le
[i
].line
== le
[i
+ 1].line
1767 && le
[i
].pc
== le
[i
+ 1].pc
)
1768 continue; /* Ignore duplicates */
1770 mle
[newlines
].line
= le
[i
].line
;
1771 if (le
[i
].line
> le
[i
+ 1].line
)
1773 mle
[newlines
].start_pc
= le
[i
].pc
;
1774 mle
[newlines
].end_pc
= le
[i
+ 1].pc
;
1778 /* If we're on the last line, and it's part of the function, then we need to
1779 get the end pc in a special way. */
1784 mle
[newlines
].line
= le
[i
].line
;
1785 mle
[newlines
].start_pc
= le
[i
].pc
;
1786 sal
= find_pc_line (le
[i
].pc
, 0);
1787 mle
[newlines
].end_pc
= sal
.end
;
1791 /* Now, sort mle by line #s (and, then by addresses within lines). */
1794 qsort (mle
, newlines
, sizeof (struct my_line_entry
), compare_lines
);
1796 /* Now, for each line entry, emit the specified lines (unless they have been
1797 emitted before), followed by the assembly code for that line. */
1799 next_line
= 0; /* Force out first line */
1800 for (i
= 0; i
< newlines
; i
++)
1802 /* Print out everything from next_line to the current line. */
1804 if (mle
[i
].line
>= next_line
)
1807 print_source_lines (symtab
, next_line
, mle
[i
].line
+ 1, 0);
1809 print_source_lines (symtab
, mle
[i
].line
, mle
[i
].line
+ 1, 0);
1811 next_line
= mle
[i
].line
+ 1;
1814 for (pc
= mle
[i
].start_pc
; pc
< mle
[i
].end_pc
; )
1817 fputs_unfiltered (" ", gdb_stdout
);
1818 print_address (pc
, gdb_stdout
);
1819 fputs_unfiltered (":\t ", gdb_stdout
);
1820 pc
+= (*tm_print_insn
) (pc
, &di
);
1821 fputs_unfiltered ("\n", gdb_stdout
);
1828 for (pc
= low
; pc
< high
; )
1831 fputs_unfiltered (" ", gdb_stdout
);
1832 print_address (pc
, gdb_stdout
);
1833 fputs_unfiltered (":\t ", gdb_stdout
);
1834 pc
+= (*tm_print_insn
) (pc
, &di
);
1835 fputs_unfiltered ("\n", gdb_stdout
);
1839 gdb_flush (gdb_stdout
);
1845 tk_command (cmd
, from_tty
)
1851 struct cleanup
*old_chain
;
1853 /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1855 error_no_arg ("tcl command to interpret");
1857 retval
= Tcl_Eval (interp
, cmd
);
1859 result
= strdup (interp
->result
);
1861 old_chain
= make_cleanup (free
, result
);
1863 if (retval
!= TCL_OK
)
1866 printf_unfiltered ("%s\n", result
);
1868 do_cleanups (old_chain
);
1872 cleanup_init (ignored
)
1876 Tcl_DeleteInterp (interp
);
1880 /* Come here during long calculations to check for GUI events. Usually invoked
1881 via the QUIT macro. */
1884 gdbtk_interactive ()
1886 /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1889 /* Come here when there is activity on the X file descriptor. */
1895 static int in_x_event
= 0;
1896 static Tcl_Obj
*varname
= NULL
;
1897 if (in_x_event
|| in_fputs
)
1904 if (gdbtk_timer_going
)
1905 gdbtk_stop_timer ();
1908 /* Process pending events */
1909 while (Tcl_DoOneEvent (TCL_DONT_WAIT
|TCL_ALL_EVENTS
) != 0)
1912 if (load_in_progress
)
1915 if (varname
== NULL
)
1917 Tcl_Obj
*varnamestrobj
= Tcl_NewStringObj("download_cancel_ok",-1);
1918 varname
= Tcl_ObjGetVar2(interp
,varnamestrobj
,NULL
,TCL_GLOBAL_ONLY
);
1920 if ((Tcl_GetIntFromObj(interp
,varname
,&val
) == TCL_OK
) && val
)
1934 /* For Cygwin32, we use a timer to periodically check for Windows
1935 messages. FIXME: It would be better to not poll, but to instead
1936 rewrite the target_wait routines to serve as input sources.
1937 Unfortunately, that will be a lot of work. */
1938 static sigset_t nullsigmask
;
1939 static struct sigaction act1
, act2
;
1940 static struct itimerval it_on
, it_off
;
1943 gdbtk_start_timer ()
1945 static int first
= 1;
1946 /*TclDebug ("Starting timer....");*/
1949 /* first time called, set up all the structs */
1951 sigemptyset (&nullsigmask
);
1953 act1
.sa_handler
= x_event
;
1954 act1
.sa_mask
= nullsigmask
;
1957 act2
.sa_handler
= SIG_IGN
;
1958 act2
.sa_mask
= nullsigmask
;
1961 it_on
.it_interval
.tv_sec
= 0;
1962 it_on
.it_interval
.tv_usec
= 250000; /* .25 sec */
1963 it_on
.it_value
.tv_sec
= 0;
1964 it_on
.it_value
.tv_usec
= 250000;
1966 it_off
.it_interval
.tv_sec
= 0;
1967 it_off
.it_interval
.tv_usec
= 0;
1968 it_off
.it_value
.tv_sec
= 0;
1969 it_off
.it_value
.tv_usec
= 0;
1972 if (!gdbtk_timer_going
)
1974 sigaction (SIGALRM
, &act1
, NULL
);
1975 setitimer (ITIMER_REAL
, &it_on
, NULL
);
1976 gdbtk_timer_going
= 1;
1983 if (gdbtk_timer_going
)
1985 gdbtk_timer_going
= 0;
1986 /*TclDebug ("Stopping timer.");*/
1987 setitimer (ITIMER_REAL
, &it_off
, NULL
);
1988 sigaction (SIGALRM
, &act2
, NULL
);
1992 /* This hook function is called whenever we want to wait for the
1996 gdbtk_wait (pid
, ourstatus
)
1998 struct target_waitstatus
*ourstatus
;
2000 gdbtk_start_timer ();
2001 pid
= target_wait (pid
, ourstatus
);
2002 gdbtk_stop_timer ();
2006 /* This is called from execute_command, and provides a wrapper around
2007 various command routines in a place where both protocol messages and
2008 user input both flow through. Mostly this is used for indicating whether
2009 the target process is running or not.
2013 gdbtk_call_command (cmdblk
, arg
, from_tty
)
2014 struct cmd_list_element
*cmdblk
;
2019 if (cmdblk
->class == class_run
|| cmdblk
->class == class_trace
)
2022 /* HACK! HACK! This is to get the gui to update the tstart/tstop
2023 button only incase of tstart/tstop commands issued from the console
2024 We don't want to update the src window, s we need to have specific
2025 procedures to do tstart and tstop
2027 if (!strcmp(cmdblk
->name
, "tstart") && !No_Update
)
2028 Tcl_Eval (interp
, "gdbtk_tcl_tstart");
2029 else if (!strcmp(cmdblk
->name
, "tstop") && !No_Update
)
2030 Tcl_Eval (interp
, "gdbtk_tcl_tstop");
2036 Tcl_Eval (interp
, "gdbtk_tcl_busy");
2037 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2040 Tcl_Eval (interp
, "gdbtk_tcl_idle");
2044 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2047 /* This function is called instead of gdb's internal command loop. This is the
2048 last chance to do anything before entering the main Tk event loop. */
2053 extern GDB_FILE
*instream
;
2055 /* We no longer want to use stdin as the command input stream */
2058 if (Tcl_Eval (interp
, "gdbtk_tcl_preloop") != TCL_OK
)
2062 /* Force errorInfo to be set up propertly. */
2063 Tcl_AddErrorInfo (interp
, "");
2065 msg
= Tcl_GetVar (interp
, "errorInfo", TCL_GLOBAL_ONLY
);
2067 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
2069 fputs_unfiltered (msg
, gdb_stderr
);
2080 /* gdbtk_init installs this function as a final cleanup. */
2083 gdbtk_cleanup (dummy
)
2087 struct ide_event_handle
*h
= (struct ide_event_handle
*) dummy
;
2089 ide_interface_deregister_all (h
);
2094 /* Initialize gdbtk. */
2097 gdbtk_init ( argv0
)
2100 struct cleanup
*old_chain
;
2101 char *lib
, *gdbtk_lib
, *gdbtk_lib_tmp
, *gdbtk_file
;
2104 struct sigaction action
;
2105 static sigset_t nullsigmask
= {0};
2108 /* start-sanitize-ide */
2109 struct ide_event_handle
*h
;
2112 /* end-sanitize-ide */
2115 /* If there is no DISPLAY environment variable, Tk_Init below will fail,
2116 causing gdb to abort. If instead we simply return here, gdb will
2117 gracefully degrade to using the command line interface. */
2120 if (getenv ("DISPLAY") == NULL
)
2124 old_chain
= make_cleanup (cleanup_init
, 0);
2126 /* First init tcl and tk. */
2127 Tcl_FindExecutable (argv0
);
2128 interp
= Tcl_CreateInterp ();
2130 #ifdef TCL_MEM_DEBUG
2131 Tcl_InitMemory (interp
);
2135 error ("Tcl_CreateInterp failed");
2137 if (Tcl_Init(interp
) != TCL_OK
)
2138 error ("Tcl_Init failed: %s", interp
->result
);
2141 /* For the IDE we register the cleanup later, after we've
2142 initialized events. */
2143 make_final_cleanup (gdbtk_cleanup
, NULL
);
2146 /* Initialize the Paths variable. */
2147 if (ide_initialize_paths (interp
, "gdbtcl") != TCL_OK
)
2148 error ("ide_initialize_paths failed: %s", interp
->result
);
2151 /* start-sanitize-ide */
2152 /* Find the directory where we expect to find idemanager. We ignore
2153 errors since it doesn't really matter if this fails. */
2154 libexecdir
= Tcl_GetVar2 (interp
, "Paths", "libexecdir", TCL_GLOBAL_ONLY
);
2158 h
= ide_event_init_from_environment (&errmsg
, libexecdir
);
2159 make_final_cleanup (gdbtk_cleanup
, h
);
2162 Tcl_AppendResult (interp
, "can't initialize event system: ", errmsg
,
2164 fprintf(stderr
, "WARNING: ide_event_init_client failed: %s\n", interp
->result
);
2166 Tcl_SetVar (interp
, "GDBTK_IDE", "0", 0);
2170 if (ide_create_tclevent_command (interp
, h
) != TCL_OK
)
2171 error ("ide_create_tclevent_command failed: %s", interp
->result
);
2173 if (ide_create_edit_command (interp
, h
) != TCL_OK
)
2174 error ("ide_create_edit_command failed: %s", interp
->result
);
2176 if (ide_create_property_command (interp
, h
) != TCL_OK
)
2177 error ("ide_create_property_command failed: %s", interp
->result
);
2179 if (ide_create_build_command (interp
, h
) != TCL_OK
)
2180 error ("ide_create_build_command failed: %s", interp
->result
);
2182 if (ide_create_window_register_command (interp
, h
, "gdb-restore")
2184 error ("ide_create_window_register_command failed: %s",
2187 if (ide_create_window_command (interp
, h
) != TCL_OK
)
2188 error ("ide_create_window_command failed: %s", interp
->result
);
2190 if (ide_create_exit_command (interp
, h
) != TCL_OK
)
2191 error ("ide_create_exit_command failed: %s", interp
->result
);
2193 if (ide_create_help_command (interp
) != TCL_OK
)
2194 error ("ide_create_help_command failed: %s", interp
->result
);
2197 if (ide_initialize (interp, "gdb") != TCL_OK)
2198 error ("ide_initialize failed: %s", interp->result);
2201 Tcl_SetVar (interp
, "GDBTK_IDE", "1", 0);
2203 /* end-sanitize-ide */
2205 Tcl_SetVar (interp
, "GDBTK_IDE", "0", 0);
2208 /* We don't want to open the X connection until we've done all the
2209 IDE initialization. Otherwise, goofy looking unfinished windows
2210 pop up when ILU drops into the TCL event loop. */
2212 if (Tk_Init(interp
) != TCL_OK
)
2213 error ("Tk_Init failed: %s", interp
->result
);
2215 if (Itcl_Init(interp
) == TCL_ERROR
)
2216 error ("Itcl_Init failed: %s", interp
->result
);
2218 if (Tix_Init(interp
) != TCL_OK
)
2219 error ("Tix_Init failed: %s", interp
->result
);
2222 if (ide_create_messagebox_command (interp
) != TCL_OK
)
2223 error ("messagebox command initialization failed");
2224 /* On Windows, create a sizebox widget command */
2225 if (ide_create_sizebox_command (interp
) != TCL_OK
)
2226 error ("sizebox creation failed");
2227 if (ide_create_winprint_command (interp
) != TCL_OK
)
2228 error ("windows print code initialization failed");
2229 /* start-sanitize-ide */
2230 /* An interface to ShellExecute. */
2231 if (ide_create_shell_execute_command (interp
) != TCL_OK
)
2232 error ("shell execute command initialization failed");
2233 /* end-sanitize-ide */
2234 if (ide_create_win_grab_command (interp
) != TCL_OK
)
2235 error ("grab support command initialization failed");
2236 /* Path conversion functions. */
2237 if (ide_create_cygwin_path_command (interp
) != TCL_OK
)
2238 error ("cygwin path command initialization failed");
2241 Tcl_CreateCommand (interp
, "gdb_cmd", call_wrapper
, gdb_cmd
, NULL
);
2242 Tcl_CreateCommand (interp
, "gdb_immediate", call_wrapper
,
2243 gdb_immediate_command
, NULL
);
2244 Tcl_CreateCommand (interp
, "gdb_loc", call_wrapper
, gdb_loc
, NULL
);
2245 Tcl_CreateCommand (interp
, "gdb_path_conv", call_wrapper
, gdb_path_conv
, NULL
);
2246 Tcl_CreateObjCommand (interp
, "gdb_listfiles", call_obj_wrapper
, gdb_listfiles
, NULL
);
2247 Tcl_CreateCommand (interp
, "gdb_listfuncs", call_wrapper
, gdb_listfuncs
,
2249 Tcl_CreateCommand (interp
, "gdb_get_mem", call_wrapper
, gdb_get_mem
,
2251 Tcl_CreateCommand (interp
, "gdb_stop", call_wrapper
, gdb_stop
, NULL
);
2252 Tcl_CreateCommand (interp
, "gdb_regnames", call_wrapper
, gdb_regnames
, NULL
);
2253 Tcl_CreateCommand (interp
, "gdb_fetch_registers", call_wrapper
,
2254 gdb_fetch_registers
, NULL
);
2255 Tcl_CreateCommand (interp
, "gdb_changed_register_list", call_wrapper
,
2256 gdb_changed_register_list
, NULL
);
2257 Tcl_CreateCommand (interp
, "gdb_disassemble", call_wrapper
,
2258 gdb_disassemble
, NULL
);
2259 Tcl_CreateCommand (interp
, "gdb_eval", call_wrapper
, gdb_eval
, NULL
);
2260 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_list", call_wrapper
,
2261 gdb_get_breakpoint_list
, NULL
);
2262 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_info", call_wrapper
,
2263 gdb_get_breakpoint_info
, NULL
);
2264 Tcl_CreateCommand (interp
, "gdb_clear_file", call_wrapper
,
2265 gdb_clear_file
, NULL
);
2266 Tcl_CreateCommand (interp
, "gdb_confirm_quit", call_wrapper
,
2267 gdb_confirm_quit
, NULL
);
2268 Tcl_CreateCommand (interp
, "gdb_force_quit", call_wrapper
,
2269 gdb_force_quit
, NULL
);
2270 Tcl_CreateCommand (interp
, "gdb_target_has_execution",
2271 gdb_target_has_execution_command
,
2273 Tcl_CreateCommand (interp
, "gdb_is_tracing",
2276 Tcl_CreateObjCommand (interp
, "gdb_load_info", call_obj_wrapper
, gdb_load_info
, NULL
);
2277 Tcl_CreateObjCommand (interp
, "gdb_get_locals", call_obj_wrapper
, gdb_get_locals_command
,
2279 Tcl_CreateObjCommand (interp
, "gdb_get_args", call_obj_wrapper
, gdb_get_args_command
,
2281 Tcl_CreateObjCommand (interp
, "gdb_get_function", call_obj_wrapper
, gdb_get_function_command
,
2283 Tcl_CreateObjCommand (interp
, "gdb_get_line", call_obj_wrapper
, gdb_get_line_command
,
2285 Tcl_CreateObjCommand (interp
, "gdb_get_file", call_obj_wrapper
, gdb_get_file_command
,
2287 Tcl_CreateObjCommand (interp
, "gdb_tracepoint_exists",
2288 call_obj_wrapper
, gdb_tracepoint_exists_command
, NULL
);
2289 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_info",
2290 call_obj_wrapper
, gdb_get_tracepoint_info
, NULL
);
2291 Tcl_CreateObjCommand (interp
, "gdb_actions",
2292 call_obj_wrapper
, gdb_actions_command
, NULL
);
2293 Tcl_CreateObjCommand (interp
, "gdb_prompt",
2294 call_obj_wrapper
, gdb_prompt_command
, NULL
);
2295 Tcl_CreateObjCommand (interp
, "gdb_find_file",
2296 call_obj_wrapper
, gdb_find_file_command
, NULL
);
2297 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_list",
2298 call_obj_wrapper
, gdb_get_tracepoint_list
, NULL
);
2299 Tcl_CreateCommand (interp
, "gdb_pc_reg", get_pc_register
, NULL
, NULL
);
2300 Tcl_CreateObjCommand (interp
, "gdb_loadfile", call_obj_wrapper
, gdb_loadfile
, NULL
);
2301 Tcl_CreateObjCommand (interp
, "gdb_set_bp", call_obj_wrapper
, gdb_set_bp
, NULL
);
2303 command_loop_hook
= tk_command_loop
;
2304 print_frame_info_listing_hook
= gdbtk_print_frame_info
;
2305 query_hook
= gdbtk_query
;
2306 warning_hook
= gdbtk_warning
;
2307 flush_hook
= gdbtk_flush
;
2308 create_breakpoint_hook
= gdbtk_create_breakpoint
;
2309 delete_breakpoint_hook
= gdbtk_delete_breakpoint
;
2310 modify_breakpoint_hook
= gdbtk_modify_breakpoint
;
2311 interactive_hook
= gdbtk_interactive
;
2312 target_wait_hook
= gdbtk_wait
;
2313 call_command_hook
= gdbtk_call_command
;
2314 readline_begin_hook
= gdbtk_readline_begin
;
2315 readline_hook
= gdbtk_readline
;
2316 readline_end_hook
= gdbtk_readline_end
;
2317 ui_load_progress_hook
= gdbtk_load_hash
;
2319 ui_loop_hook
= x_event
;
2321 pre_add_symbol_hook
= gdbtk_pre_add_symbol
;
2322 post_add_symbol_hook
= gdbtk_post_add_symbol
;
2323 create_tracepoint_hook
= gdbtk_create_tracepoint
;
2324 delete_tracepoint_hook
= gdbtk_delete_tracepoint
;
2325 modify_tracepoint_hook
= gdbtk_modify_tracepoint
;
2326 pc_changed_hook
= pc_changed
;
2328 add_com ("tk", class_obscure
, tk_command
,
2329 "Send a command directly into tk.");
2331 Tcl_LinkVar (interp
, "disassemble-from-exec", (char *)&disassemble_from_exec
,
2334 /* find the gdb tcl library and source main.tcl */
2336 gdbtk_lib
= getenv ("GDBTK_LIBRARY");
2338 if (access ("gdbtcl/main.tcl", R_OK
) == 0)
2339 gdbtk_lib
= "gdbtcl";
2341 gdbtk_lib
= GDBTK_LIBRARY
;
2343 gdbtk_lib_tmp
= xstrdup (gdbtk_lib
);
2346 /* see if GDBTK_LIBRARY is a path list */
2347 lib
= strtok (gdbtk_lib_tmp
, GDBTK_PATH_SEP
);
2350 if (Tcl_VarEval (interp
, "lappend auto_path ", lib
, NULL
) != TCL_OK
)
2352 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
2357 gdbtk_file
= concat (lib
, "/main.tcl", (char *) NULL
);
2358 if (access (gdbtk_file
, R_OK
) == 0)
2361 Tcl_SetVar (interp
, "GDBTK_LIBRARY", lib
, 0);
2365 while ((lib
= strtok (NULL
, ":")) != NULL
);
2367 free (gdbtk_lib_tmp
);
2371 /* Try finding it with the auto path. */
2373 static const char script
[] ="\
2374 proc gdbtk_find_main {} {\n\
2375 global auto_path GDBTK_LIBRARY\n\
2376 foreach dir $auto_path {\n\
2377 set f [file join $dir main.tcl]\n\
2378 if {[file exists $f]} then {\n\
2379 set GDBTK_LIBRARY $dir\n\
2387 if (Tcl_GlobalEval (interp
, (char *) script
) != TCL_OK
)
2389 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
2393 if (interp
->result
[0] != '\0')
2395 gdbtk_file
= xstrdup (interp
->result
);
2402 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
2403 if (getenv("GDBTK_LIBRARY"))
2405 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
2406 fprintf_unfiltered (stderr
,
2407 "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
2411 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY
);
2412 fprintf_unfiltered (stderr
, "You might want to set GDBTK_LIBRARY\n");
2417 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
2418 prior to this point go to stdout/stderr. */
2420 fputs_unfiltered_hook
= gdbtk_fputs
;
2422 if (Tcl_EvalFile (interp
, gdbtk_file
) != TCL_OK
)
2426 /* Force errorInfo to be set up propertly. */
2427 Tcl_AddErrorInfo (interp
, "");
2429 msg
= Tcl_GetVar (interp
, "errorInfo", TCL_GLOBAL_ONLY
);
2431 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
2434 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
2436 fputs_unfiltered (msg
, gdb_stderr
);
2443 /* start-sanitize-ide */
2444 /* Don't do this until we have initialized. Otherwise, we may get a
2445 run command before we are ready for one. */
2446 if (ide_run_server_init (interp
, h
) != TCL_OK
)
2447 error ("ide_run_server_init failed: %s", interp
->result
);
2448 /* end-sanitize-ide */
2453 discard_cleanups (old_chain
);
2457 gdb_target_has_execution_command (clientData
, interp
, argc
, argv
)
2458 ClientData clientData
;
2465 if (target_has_execution
&& inferior_pid
!= 0)
2468 Tcl_SetIntObj (Tcl_GetObjResult (interp
), result
);
2473 gdb_trace_status (clientData
, interp
, argc
, argv
)
2474 ClientData clientData
;
2481 if (trace_running_p
)
2484 Tcl_SetIntObj (Tcl_GetObjResult (interp
), result
);
2488 /* gdb_load_info - returns information about the file about to be downloaded */
2491 gdb_load_info (clientData
, interp
, objc
, objv
)
2492 ClientData clientData
;
2495 Tcl_Obj
*CONST objv
[];
2498 struct cleanup
*old_cleanups
;
2504 char *filename
= Tcl_GetStringFromObj (objv
[1], NULL
);
2506 loadfile_bfd
= bfd_openr (filename
, gnutarget
);
2507 if (loadfile_bfd
== NULL
)
2509 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("Open failed", -1));
2512 old_cleanups
= make_cleanup (bfd_close
, loadfile_bfd
);
2514 if (!bfd_check_format (loadfile_bfd
, bfd_object
))
2516 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("Bad Object File", -1));
2520 for (s
= loadfile_bfd
->sections
; s
; s
= s
->next
)
2522 if (s
->flags
& SEC_LOAD
)
2524 bfd_size_type size
= bfd_get_section_size_before_reloc (s
);
2527 ob
[0] = Tcl_NewStringObj((char *)bfd_get_section_name(loadfile_bfd
, s
), -1);
2528 ob
[1] = Tcl_NewLongObj ((long)size
);
2529 res
[i
++] = Tcl_NewListObj (2, ob
);
2534 Tcl_SetObjResult (interp
, Tcl_NewListObj (i
, res
));
2535 do_cleanups (old_cleanups
);
2541 gdbtk_load_hash (section
, num
)
2546 sprintf (buf
, "download_hash %s %ld", section
, num
);
2547 Tcl_Eval (interp
, buf
);
2548 return atoi (interp
->result
);
2552 * This and gdb_get_locals just call gdb_get_vars_command with the right
2553 * value of clientData. We can't use the client data in the definition
2554 * of the command, because the call wrapper uses this instead...
2558 gdb_get_locals_command (clientData
, interp
, objc
, objv
)
2559 ClientData clientData
;
2562 Tcl_Obj
*CONST objv
[];
2565 return gdb_get_vars_command((ClientData
) 0, interp
, objc
, objv
);
2570 gdb_get_args_command (clientData
, interp
, objc
, objv
)
2571 ClientData clientData
;
2574 Tcl_Obj
*CONST objv
[];
2577 return gdb_get_vars_command((ClientData
) 1, interp
, objc
, objv
);
2581 /* gdb_get_vars_command -
2583 * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
2584 * function sets the Tcl interpreter's result to a list of variable names
2585 * depending on clientData. If clientData is one, the result is a list of
2586 * arguments; zero returns a list of locals -- all relative to the block
2587 * specified as an argument to the command. Valid commands include
2588 * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
2592 gdb_get_vars_command (clientData
, interp
, objc
, objv
)
2593 ClientData clientData
;
2596 Tcl_Obj
*CONST objv
[];
2599 struct symtabs_and_lines sals
;
2601 struct block
*block
;
2602 char **canonical
, *args
;
2603 int i
, nsyms
, arguments
;
2607 Tcl_AppendResult (interp
,
2608 "wrong # of args: should be \"",
2609 Tcl_GetStringFromObj (objv
[0], NULL
),
2610 " function:line|function|line|*addr\"");
2614 arguments
= (int) clientData
;
2615 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2616 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2617 if (sals
.nelts
== 0)
2619 Tcl_AppendResult (interp
,
2620 "error decoding line", NULL
);
2624 /* Initialize a list that will hold the results */
2625 result
= Tcl_NewListObj (0, NULL
);
2627 /* Resolve all line numbers to PC's */
2628 for (i
= 0; i
< sals
.nelts
; i
++)
2629 resolve_sal_pc (&sals
.sals
[i
]);
2631 block
= block_for_pc (sals
.sals
[0].pc
);
2634 nsyms
= BLOCK_NSYMS (block
);
2635 for (i
= 0; i
< nsyms
; i
++)
2637 sym
= BLOCK_SYM (block
, i
);
2638 switch (SYMBOL_CLASS (sym
)) {
2640 case LOC_UNDEF
: /* catches errors */
2641 case LOC_CONST
: /* constant */
2642 case LOC_STATIC
: /* static */
2643 case LOC_REGISTER
: /* register */
2644 case LOC_TYPEDEF
: /* local typedef */
2645 case LOC_LABEL
: /* local label */
2646 case LOC_BLOCK
: /* local function */
2647 case LOC_CONST_BYTES
: /* loc. byte seq. */
2648 case LOC_UNRESOLVED
: /* unresolved static */
2649 case LOC_OPTIMIZED_OUT
: /* optimized out */
2651 case LOC_ARG
: /* argument */
2652 case LOC_REF_ARG
: /* reference arg */
2653 case LOC_REGPARM
: /* register arg */
2654 case LOC_REGPARM_ADDR
: /* indirect register arg */
2655 case LOC_LOCAL_ARG
: /* stack arg */
2656 case LOC_BASEREG_ARG
: /* basereg arg */
2658 Tcl_ListObjAppendElement (interp
, result
,
2659 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
2661 case LOC_LOCAL
: /* stack local */
2662 case LOC_BASEREG
: /* basereg local */
2664 Tcl_ListObjAppendElement (interp
, result
,
2665 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
2669 if (BLOCK_FUNCTION (block
))
2672 block
= BLOCK_SUPERBLOCK (block
);
2675 Tcl_SetObjResult (interp
, result
);
2680 gdb_get_line_command (clientData
, interp
, objc
, objv
)
2681 ClientData clientData
;
2684 Tcl_Obj
*CONST objv
[];
2687 struct symtabs_and_lines sals
;
2688 char *args
, **canonical
;
2692 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2693 Tcl_GetStringFromObj (objv
[0], NULL
),
2698 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2699 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2700 if (sals
.nelts
== 1)
2702 Tcl_SetObjResult (interp
, Tcl_NewIntObj (sals
.sals
[0].line
));
2706 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2711 gdb_get_file_command (clientData
, interp
, objc
, objv
)
2712 ClientData clientData
;
2715 Tcl_Obj
*CONST objv
[];
2718 struct symtabs_and_lines sals
;
2719 char *args
, **canonical
;
2723 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2724 Tcl_GetStringFromObj (objv
[0], NULL
),
2729 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2730 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2731 if (sals
.nelts
== 1)
2733 Tcl_SetResult (interp
, sals
.sals
[0].symtab
->filename
, TCL_VOLATILE
);
2737 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2742 gdb_get_function_command (clientData
, interp
, objc
, objv
)
2743 ClientData clientData
;
2746 Tcl_Obj
*CONST objv
[];
2750 struct symtabs_and_lines sals
;
2751 char *args
, **canonical
;
2755 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2756 Tcl_GetStringFromObj (objv
[0], NULL
),
2761 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2762 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2763 if (sals
.nelts
== 1)
2765 resolve_sal_pc (&sals
.sals
[0]);
2766 find_pc_partial_function (sals
.sals
[0].pc
, &function
, NULL
, NULL
);
2767 if (function
!= NULL
)
2769 Tcl_SetResult (interp
, function
, TCL_VOLATILE
);
2774 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2779 gdb_get_tracepoint_info (clientData
, interp
, objc
, objv
)
2780 ClientData clientData
;
2783 Tcl_Obj
*CONST objv
[];
2785 struct symtab_and_line sal
;
2787 struct tracepoint
*tp
;
2788 struct action_line
*al
;
2789 Tcl_Obj
*list
, *action_list
;
2790 char *filename
, *funcname
;
2794 error ("wrong # args");
2796 Tcl_GetIntFromObj (NULL
, objv
[1], &tpnum
);
2798 ALL_TRACEPOINTS (tp
)
2799 if (tp
->number
== tpnum
)
2803 error ("Tracepoint #%d does not exist", tpnum
);
2805 list
= Tcl_NewListObj (0, NULL
);
2806 sal
= find_pc_line (tp
->address
, 0);
2807 filename
= symtab_to_filename (sal
.symtab
);
2808 if (filename
== NULL
)
2810 Tcl_ListObjAppendElement (interp
, list
,
2811 Tcl_NewStringObj (filename
, -1));
2812 find_pc_partial_function (tp
->address
, &funcname
, NULL
, NULL
);
2813 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewStringObj (funcname
, -1));
2814 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (sal
.line
));
2815 sprintf (tmp
, "0x%lx", tp
->address
);
2816 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewStringObj (tmp
, -1));
2817 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->enabled
));
2818 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->pass_count
));
2819 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->step_count
));
2820 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->thread
));
2821 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->hit_count
));
2823 /* Append a list of actions */
2824 action_list
= Tcl_NewListObj (0, NULL
);
2825 for (al
= tp
->actions
; al
!= NULL
; al
= al
->next
)
2827 Tcl_ListObjAppendElement (interp
, action_list
,
2828 Tcl_NewStringObj (al
->action
, -1));
2830 Tcl_ListObjAppendElement (interp
, list
, action_list
);
2832 Tcl_SetObjResult (interp
, list
);
2837 /* TclDebug (const char *fmt, ...) works just like printf() but */
2838 /* sends the output to the GDB TK debug window. */
2839 /* Not for normal use; just a convenient tool for debugging */
2841 #ifdef ANSI_PROTOTYPES
2842 TclDebug (const char *fmt
, ...)
2849 char buf
[512], *v
[2], *merge
;
2851 #ifdef ANSI_PROTOTYPES
2852 va_start (args
, fmt
);
2856 fmt
= va_arg (args
, char *);
2862 vsprintf (buf
, fmt
, args
);
2865 merge
= Tcl_Merge (2, v
);
2866 Tcl_Eval (interp
, merge
);
2871 /* Find the full pathname to a file, searching the symbol tables */
2874 gdb_find_file_command (clientData
, interp
, objc
, objv
)
2875 ClientData clientData
;
2878 Tcl_Obj
*CONST objv
[];
2880 char *filename
= NULL
;
2885 Tcl_WrongNumArgs(interp
, 1, objv
, "filename");
2889 st
= full_lookup_symtab (Tcl_GetStringFromObj (objv
[1], NULL
));
2891 filename
= st
->fullname
;
2893 if (filename
== NULL
)
2894 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("", 0));
2896 Tcl_SetObjResult (interp
, Tcl_NewStringObj (filename
, -1));
2902 gdbtk_create_tracepoint (tp
)
2903 struct tracepoint
*tp
;
2905 tracepoint_notify (tp
, "create");
2909 gdbtk_delete_tracepoint (tp
)
2910 struct tracepoint
*tp
;
2912 tracepoint_notify (tp
, "delete");
2916 gdbtk_modify_tracepoint (tp
)
2917 struct tracepoint
*tp
;
2919 tracepoint_notify (tp
, "modify");
2923 tracepoint_notify(tp
, action
)
2924 struct tracepoint
*tp
;
2929 struct symtab_and_line sal
;
2932 /* We ensure that ACTION contains no special Tcl characters, so we
2934 sal
= find_pc_line (tp
->address
, 0);
2936 filename
= symtab_to_filename (sal
.symtab
);
2937 if (filename
== NULL
)
2939 sprintf (buf
, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action
, tp
->number
,
2940 (long)tp
->address
, sal
.line
, filename
, tp
->pass_count
);
2942 v
= Tcl_Eval (interp
, buf
);
2946 gdbtk_fputs (interp
->result
, gdb_stdout
);
2947 gdbtk_fputs ("\n", gdb_stdout
);
2951 /* returns -1 if not found, tracepoint # if found */
2953 tracepoint_exists (char * args
)
2955 struct tracepoint
*tp
;
2957 struct symtabs_and_lines sals
;
2961 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2962 if (sals
.nelts
== 1)
2964 resolve_sal_pc (&sals
.sals
[0]);
2965 file
= xmalloc (strlen (sals
.sals
[0].symtab
->dirname
)
2966 + strlen (sals
.sals
[0].symtab
->filename
) + 1);
2969 strcpy (file
, sals
.sals
[0].symtab
->dirname
);
2970 strcat (file
, sals
.sals
[0].symtab
->filename
);
2972 ALL_TRACEPOINTS (tp
)
2974 if (tp
->address
== sals
.sals
[0].pc
)
2975 result
= tp
->number
;
2977 /* Why is this here? This messes up assembly traces */
2978 else if (tp
->source_file
!= NULL
2979 && strcmp (tp
->source_file
, file
) == 0
2980 && sals
.sals
[0].line
== tp
->line_number
)
2981 result
= tp
->number
;
2992 gdb_actions_command (clientData
, interp
, objc
, objv
)
2993 ClientData clientData
;
2996 Tcl_Obj
*CONST objv
[];
2998 struct tracepoint
*tp
;
3000 int nactions
, i
, len
;
3001 char *number
, *args
, *action
;
3003 struct action_line
*next
= NULL
, *temp
;
3007 Tcl_AppendResult (interp
, "wrong # args: should be: \"",
3008 Tcl_GetStringFromObj (objv
[0], NULL
),
3009 " number actions\"");
3013 args
= number
= Tcl_GetStringFromObj (objv
[1], NULL
);
3014 tp
= get_tracepoint_by_number (&args
);
3017 Tcl_AppendResult (interp
, "Tracepoint \"", number
, "\" does not exist");
3021 /* Free any existing actions */
3022 if (tp
->actions
!= NULL
)
3027 Tcl_ListObjGetElements (interp
, objv
[2], &nactions
, &actions
);
3028 for (i
= 0; i
< nactions
; i
++)
3030 temp
= xmalloc (sizeof (struct action_line
));
3032 action
= Tcl_GetStringFromObj (actions
[i
], &len
);
3033 temp
->action
= savestring (action
, len
);
3034 if (sscanf (temp
->action
, "while-stepping %d", &step_count
) !=0)
3035 tp
->step_count
= step_count
;
3052 gdb_tracepoint_exists_command (clientData
, interp
, objc
, objv
)
3053 ClientData clientData
;
3056 Tcl_Obj
*CONST objv
[];
3062 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
3063 Tcl_GetStringFromObj (objv
[0], NULL
),
3064 " function:line|function|line|*addr\"");
3068 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
3070 Tcl_SetObjResult (interp
, Tcl_NewIntObj (tracepoint_exists (args
)));
3074 /* Return the prompt to the interpreter */
3076 gdb_prompt_command (clientData
, interp
, objc
, objv
)
3077 ClientData clientData
;
3080 Tcl_Obj
*CONST objv
[];
3082 Tcl_SetResult (interp
, get_prompt (), TCL_VOLATILE
);
3086 /* return a list of all tracepoint numbers in interpreter */
3088 gdb_get_tracepoint_list (clientData
, interp
, objc
, objv
)
3089 ClientData clientData
;
3092 Tcl_Obj
*CONST objv
[];
3095 struct tracepoint
*tp
;
3097 list
= Tcl_NewListObj (0, NULL
);
3099 ALL_TRACEPOINTS (tp
)
3100 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->number
));
3102 Tcl_SetObjResult (interp
, list
);
3107 /* This hook is called whenever we are ready to load a symbol file so that
3108 the UI can notify the user... */
3110 gdbtk_pre_add_symbol (name
)
3115 v
[0] = "gdbtk_tcl_pre_add_symbol";
3117 merge
= Tcl_Merge (2, v
);
3118 Tcl_Eval (interp
, merge
);
3122 /* This hook is called whenever we finish loading a symbol file. */
3124 gdbtk_post_add_symbol ()
3126 Tcl_Eval (interp
, "gdbtk_tcl_post_add_symbol");
3132 gdbtk_print_frame_info (s
, line
, stopline
, noerror
)
3138 current_source_symtab
= s
;
3139 current_source_line
= line
;
3143 /* The lookup_symtab() in symtab.c doesn't work correctly */
3144 /* It will not work will full pathnames and if multiple */
3145 /* source files have the same basename, it will return */
3146 /* the first one instead of the correct one. This version */
3147 /* also always makes sure symtab->fullname is set. */
3149 static struct symtab
*
3150 full_lookup_symtab(file
)
3154 struct objfile
*objfile
;
3155 char *bfile
, *fullname
;
3156 struct partial_symtab
*pt
;
3161 /* first try a direct lookup */
3162 st
= lookup_symtab (file
);
3166 symtab_to_filename(st
);
3170 /* if the direct approach failed, try */
3171 /* looking up the basename and checking */
3172 /* all matches with the fullname */
3173 bfile
= basename (file
);
3174 ALL_SYMTABS (objfile
, st
)
3176 if (!strcmp (bfile
, basename(st
->filename
)))
3179 fullname
= symtab_to_filename (st
);
3181 fullname
= st
->fullname
;
3183 if (!strcmp (file
, fullname
))
3188 /* still no luck? look at psymtabs */
3189 ALL_PSYMTABS (objfile
, pt
)
3191 if (!strcmp (bfile
, basename(pt
->filename
)))
3193 st
= PSYMTAB_TO_SYMTAB (pt
);
3196 fullname
= symtab_to_filename (st
);
3197 if (!strcmp (file
, fullname
))
3206 perror_with_name_wrapper (args
)
3209 perror_with_name (args
);
3213 /* gdb_loadfile loads a c source file into a text widget. */
3215 /* LTABLE_SIZE is the number of bytes to allocate for the */
3216 /* line table. Its size limits the maximum number of lines */
3217 /* in a file to 8 * LTABLE_SIZE. This memory is freed after */
3218 /* the file is loaded, so it is OK to make this very large. */
3219 /* Additional memory will be allocated if needed. */
3220 #define LTABLE_SIZE 20000
3223 gdb_loadfile (clientData
, interp
, objc
, objv
)
3224 ClientData clientData
;
3227 Tcl_Obj
*CONST objv
[];
3229 char *file
, *widget
, *line
, *buf
, msg
[128];
3230 int linenumbers
, ln
, anum
, lnum
, ltable_size
;
3231 Tcl_Obj
*a
[2], *b
[2], *cmd
;
3234 struct symtab
*symtab
;
3235 struct linetable_entry
*le
;
3242 Tcl_WrongNumArgs(interp
, 1, objv
, "widget filename linenumbers");
3246 widget
= Tcl_GetStringFromObj (objv
[1], NULL
);
3247 file
= Tcl_GetStringFromObj (objv
[2], NULL
);
3248 Tcl_GetBooleanFromObj (interp
, objv
[3], &linenumbers
);
3250 if ((fp
= fopen ( file
, "r" )) == NULL
)
3253 symtab
= full_lookup_symtab (file
);
3256 sprintf(msg
, "File not found");
3257 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3262 if (stat (file
, &st
) < 0)
3264 catch_errors (perror_with_name_wrapper
, "gdbtk: get time stamp", "",
3269 if (symtab
&& symtab
->objfile
&& symtab
->objfile
->obfd
)
3270 mtime
= bfd_get_mtime(symtab
->objfile
->obfd
);
3272 mtime
= bfd_get_mtime(exec_bfd
);
3274 if (mtime
&& mtime
< st
.st_mtime
)
3275 gdbtk_ignorable_warning("Source file is more recent than executable.\n");
3278 /* Source linenumbers don't appear to be in order, and a sort is */
3279 /* too slow so the fastest solution is just to allocate a huge */
3280 /* array and set the array entry for each linenumber */
3282 ltable_size
= LTABLE_SIZE
;
3283 ltable
= (char *)malloc (LTABLE_SIZE
);
3286 sprintf(msg
, "Out of memory.");
3287 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3292 memset (ltable
, 0, LTABLE_SIZE
);
3294 if (symtab
->linetable
&& symtab
->linetable
->nitems
)
3296 le
= symtab
->linetable
->item
;
3297 for (ln
= symtab
->linetable
->nitems
;ln
> 0; ln
--, le
++)
3299 lnum
= le
->line
>> 3;
3300 if (lnum
>= ltable_size
)
3303 new_ltable
= (char *)realloc (ltable
, ltable_size
*2);
3304 memset (new_ltable
+ ltable_size
, 0, ltable_size
);
3306 if (new_ltable
== NULL
)
3308 sprintf(msg
, "Out of memory.");
3309 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3314 ltable
= new_ltable
;
3316 ltable
[lnum
] |= 1 << (le
->line
% 8);
3320 /* create an object with enough space, then grab its */
3321 /* buffer and sprintf directly into it. */
3322 a
[0] = Tcl_NewStringObj (ltable
, 1024);
3323 a
[1] = Tcl_NewListObj(0,NULL
);
3325 b
[0] = Tcl_NewStringObj (ltable
,1024);
3326 b
[1] = Tcl_NewStringObj ("source_tag", -1);
3327 Tcl_IncrRefCount (b
[0]);
3328 Tcl_IncrRefCount (b
[1]);
3329 line
= b
[0]->bytes
+ 1;
3330 strcpy(b
[0]->bytes
,"\t");
3333 while (fgets (line
, 980, fp
))
3337 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
3339 sprintf (buf
,"%s insert end {-\t%d} break_tag", widget
, ln
);
3340 a
[0]->length
= strlen (buf
);
3344 sprintf (buf
,"%s insert end { \t%d} \"\"", widget
, ln
);
3345 a
[0]->length
= strlen (buf
);
3350 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
3352 sprintf (buf
,"%s insert end {-\t} break_tag", widget
);
3353 a
[0]->length
= strlen (buf
);
3357 sprintf (buf
,"%s insert end { \t} \"\"", widget
);
3358 a
[0]->length
= strlen (buf
);
3361 b
[0]->length
= strlen(b
[0]->bytes
);
3362 Tcl_SetListObj(a
[1],2,b
);
3363 cmd
= Tcl_ConcatObj(2,a
);
3364 Tcl_EvalObj (interp
, cmd
);
3365 Tcl_DecrRefCount (cmd
);
3368 Tcl_DecrRefCount (b
[0]);
3369 Tcl_DecrRefCount (b
[0]);
3370 Tcl_DecrRefCount (b
[1]);
3371 Tcl_DecrRefCount (b
[1]);
3377 /* at some point make these static in breakpoint.c and move GUI code there */
3378 extern struct breakpoint
*set_raw_breakpoint (struct symtab_and_line sal
);
3379 extern void set_breakpoint_count (int);
3380 extern int breakpoint_count
;
3382 /* set a breakpoint by source file and line number */
3383 /* flags are as follows: */
3384 /* least significant 2 bits are disposition, rest is */
3385 /* type (normally 0).
3388 bp_breakpoint, Normal breakpoint
3389 bp_hardware_breakpoint, Hardware assisted breakpoint
3392 Disposition of breakpoint. Ie: what to do after hitting it.
3395 del_at_next_stop, Delete at next stop, whether hit or not
3397 donttouch Leave it alone
3402 gdb_set_bp (clientData
, interp
, objc
, objv
)
3403 ClientData clientData
;
3406 Tcl_Obj
*CONST objv
[];
3409 struct symtab_and_line sal
;
3410 int line
, flags
, ret
;
3411 struct breakpoint
*b
;
3413 Tcl_Obj
*a
[5], *cmd
;
3417 Tcl_WrongNumArgs(interp
, 1, objv
, "filename line type");
3421 sal
.symtab
= full_lookup_symtab (Tcl_GetStringFromObj( objv
[1], NULL
));
3422 if (sal
.symtab
== NULL
)
3425 if (Tcl_GetIntFromObj( interp
, objv
[2], &line
) == TCL_ERROR
)
3428 if (Tcl_GetIntFromObj( interp
, objv
[3], &flags
) == TCL_ERROR
)
3432 sal
.pc
= find_line_pc (sal
.symtab
, sal
.line
);
3436 sal
.section
= find_pc_overlay (sal
.pc
);
3437 b
= set_raw_breakpoint (sal
);
3438 set_breakpoint_count (breakpoint_count
+ 1);
3439 b
->number
= breakpoint_count
;
3440 b
->type
= flags
>> 2;
3441 b
->disposition
= flags
& 3;
3443 /* FIXME: this won't work for duplicate basenames! */
3444 sprintf (buf
, "%s:%d", basename(Tcl_GetStringFromObj( objv
[1], NULL
)), line
);
3445 b
->addr_string
= strsave (buf
);
3447 /* now send notification command back to GUI */
3448 sprintf (buf
, "0x%x", sal
.pc
);
3449 a
[0] = Tcl_NewStringObj ("gdbtk_tcl_breakpoint create", -1);
3450 a
[1] = Tcl_NewIntObj (b
->number
);
3451 a
[2] = Tcl_NewStringObj (buf
, -1);
3453 a
[4] = Tcl_NewListObj (1,&objv
[1]);
3454 cmd
= Tcl_ConcatObj(5,a
);
3455 ret
= Tcl_EvalObj (interp
, cmd
);
3456 Tcl_DecrRefCount (cmd
);
3460 /* Come here during initialize_all_files () */
3463 _initialize_gdbtk ()
3467 /* Tell the rest of the world that Gdbtk is now set up. */
3469 init_ui_hook
= gdbtk_init
;
3471 (void) FreeConsole ();
3477 DWORD ft
= GetFileType (GetStdHandle (STD_INPUT_HANDLE
));
3478 void cygwin32_attach_handle_to_fd (char *, int, HANDLE
, int, int);
3482 case FILE_TYPE_DISK
:
3483 case FILE_TYPE_CHAR
:
3484 case FILE_TYPE_PIPE
:
3488 cygwin32_attach_handle_to_fd ("/dev/conin", 0,
3489 GetStdHandle (STD_INPUT_HANDLE
),
3491 cygwin32_attach_handle_to_fd ("/dev/conout", 1,
3492 GetStdHandle (STD_OUTPUT_HANDLE
),
3494 cygwin32_attach_handle_to_fd ("/dev/conout", 2,
3495 GetStdHandle (STD_ERROR_HANDLE
),