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));
94 char * get_prompt
PARAMS ((void));
96 static void null_routine
PARAMS ((int));
97 static void gdbtk_flush
PARAMS ((FILE *));
98 static void gdbtk_fputs
PARAMS ((const char *, FILE *));
99 static int gdbtk_query
PARAMS ((const char *, va_list));
100 static void gdbtk_warning
PARAMS ((const char *, va_list));
101 static void gdbtk_ignorable_warning
PARAMS ((const char *));
102 static char *gdbtk_readline
PARAMS ((char *));
103 static void gdbtk_init
PARAMS ((char *));
104 static void tk_command_loop
PARAMS ((void));
105 static void gdbtk_call_command
PARAMS ((struct cmd_list_element
*, char *, int));
106 static int gdbtk_wait
PARAMS ((int, struct target_waitstatus
*));
107 static void x_event
PARAMS ((int));
108 static void gdbtk_interactive
PARAMS ((void));
109 static void cleanup_init
PARAMS ((int));
110 static void tk_command
PARAMS ((char *, int));
111 static int gdb_disassemble
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
112 static int compare_lines
PARAMS ((const PTR
, const PTR
));
113 static int gdbtk_dis_asm_read_memory
PARAMS ((bfd_vma
, bfd_byte
*, int, disassemble_info
*));
114 static int gdb_path_conv
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
115 static int gdb_stop
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
116 static int gdb_confirm_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
117 static int gdb_force_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
118 static int gdb_listfiles
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
119 static int gdb_listfuncs
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
120 static int call_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
121 static int call_obj_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
122 static int gdb_cmd
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
123 static int gdb_immediate_command
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
124 static int gdb_fetch_registers
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
125 static void gdbtk_readline_end
PARAMS ((void));
126 static void pc_changed
PARAMS ((void));
127 static int gdb_changed_register_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
128 static void register_changed_p
PARAMS ((int, void *));
129 static int gdb_get_breakpoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
130 static int gdb_get_breakpoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
131 static void breakpoint_notify
PARAMS ((struct breakpoint
*, const char *));
132 static void gdbtk_create_breakpoint
PARAMS ((struct breakpoint
*));
133 static void gdbtk_delete_breakpoint
PARAMS ((struct breakpoint
*));
134 static void gdbtk_modify_breakpoint
PARAMS ((struct breakpoint
*));
135 static int gdb_loc
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
136 static int gdb_eval
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
137 static int map_arg_registers
PARAMS ((int, char *[], void (*) (int, void *), void *));
138 static void get_register_name
PARAMS ((int, void *));
139 static int gdb_regnames
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
140 static void get_register
PARAMS ((int, void *));
141 static int gdb_trace_status
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
142 static int gdb_target_has_execution_command
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
143 static int gdb_load_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
144 void TclDebug
PARAMS ((const char *fmt
, ...));
145 static int gdb_get_locals_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
147 static int gdb_get_args_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
149 static int gdb_get_vars_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
150 static int gdb_get_function_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
151 static int gdb_get_line_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
152 static int gdb_get_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
153 static int gdb_tracepoint_exists_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
154 static int gdb_get_tracepoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
155 static int gdb_actions_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
156 static int gdb_prompt_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
157 static int gdb_find_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
158 static int gdb_get_tracepoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
159 static void gdbtk_create_tracepoint
PARAMS ((struct tracepoint
*));
160 static void gdbtk_delete_tracepoint
PARAMS ((struct tracepoint
*));
161 static void gdbtk_modify_tracepoint
PARAMS ((struct tracepoint
*));
162 static void tracepoint_notify
PARAMS ((struct tracepoint
*, const char *));
163 static void gdbtk_print_frame_info
PARAMS ((struct symtab
*, int, int, int));
164 void gdbtk_pre_add_symbol
PARAMS ((char *));
165 void gdbtk_post_add_symbol
PARAMS ((void));
166 static int get_pc_register
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
167 static int gdb_loadfile
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
168 static int gdb_set_bp
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
169 static struct symtab
*full_lookup_symtab
PARAMS ((char *file
));
170 static int gdb_get_mem
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
172 /* Handle for TCL interpreter */
173 static Tcl_Interp
*interp
= NULL
;
175 static int gdbtk_timer_going
= 0;
176 static void gdbtk_start_timer
PARAMS ((void));
177 static void gdbtk_stop_timer
PARAMS ((void));
179 /* This variable is true when the inferior is running. Although it's
180 possible to disable most input from widgets and thus prevent
181 attempts to do anything while the inferior is running, any commands
182 that get through - even a simple memory read - are Very Bad, and
183 may cause GDB to crash or behave strangely. So, this variable
184 provides an extra layer of defense. */
186 static int running_now
;
188 /* This variable determines where memory used for disassembly is read from.
189 If > 0, then disassembly comes from the exec file rather than the
190 target (which might be at the other end of a slow serial link). If
191 == 0 then disassembly comes from target. If < 0 disassembly is
192 automatically switched to the target if it's an inferior process,
193 otherwise the exec file is used. */
195 static int disassemble_from_exec
= -1;
199 /* Supply malloc calls for tcl/tk. We do not want to do this on
200 Windows, because Tcl_Alloc is probably in a DLL which will not call
201 the mmalloc routines. */
207 return xmalloc (size
);
211 Tcl_Realloc (ptr
, size
)
215 return xrealloc (ptr
, size
);
225 #endif /* ! _WIN32 */
235 /* On Windows, if we hold a file open, other programs can't write to
236 it. In particular, we don't want to hold the executable open,
237 because it will mean that people have to get out of the debugging
238 session in order to remake their program. So we close it, although
239 this will cost us if and when we need to reopen it. */
249 bfd_cache_close (o
->obfd
);
252 if (exec_bfd
!= NULL
)
253 bfd_cache_close (exec_bfd
);
258 /* The following routines deal with stdout/stderr data, which is created by
259 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
260 lowest level of these routines and capture all output from the rest of GDB.
261 Normally they present their data to tcl via callbacks to the following tcl
262 routines: gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush. These
263 in turn call tk routines to update the display.
265 Under some circumstances, you may want to collect the output so that it can
266 be returned as the value of a tcl procedure. This can be done by
267 surrounding the output routines with calls to start_saving_output and
268 finish_saving_output. The saved data can then be retrieved with
269 get_saved_output (but this must be done before the call to
270 finish_saving_output). */
272 /* Dynamic string for output. */
274 static Tcl_DString
*result_ptr
;
276 /* Dynamic string for stderr. This is only used if result_ptr is
279 static Tcl_DString
*error_string_ptr
;
286 /* Force immediate screen update */
288 Tcl_VarEval (interp
, "gdbtk_tcl_flush", NULL
);
293 gdbtk_fputs (ptr
, stream
)
297 char *merge
[2], *command
;
301 Tcl_DStringAppend (result_ptr
, (char *) ptr
, -1);
302 else if (error_string_ptr
!= NULL
&& stream
== gdb_stderr
)
303 Tcl_DStringAppend (error_string_ptr
, (char *) ptr
, -1);
306 merge
[0] = "gdbtk_tcl_fputs";
307 merge
[1] = (char *)ptr
;
308 command
= Tcl_Merge (2, merge
);
309 Tcl_Eval (interp
, command
);
316 gdbtk_warning (warning
, args
)
320 char buf
[200], *merge
[2];
323 vsprintf (buf
, warning
, args
);
324 merge
[0] = "gdbtk_tcl_warning";
326 command
= Tcl_Merge (2, merge
);
327 Tcl_Eval (interp
, command
);
332 gdbtk_ignorable_warning (warning
)
335 char buf
[200], *merge
[2];
338 sprintf (buf
, warning
);
339 merge
[0] = "gdbtk_tcl_ignorable_warning";
341 command
= Tcl_Merge (2, merge
);
342 Tcl_Eval (interp
, command
);
347 gdbtk_query (query
, args
)
351 char buf
[200], *merge
[2];
355 vsprintf (buf
, query
, args
);
356 merge
[0] = "gdbtk_tcl_query";
358 command
= Tcl_Merge (2, merge
);
359 Tcl_Eval (interp
, command
);
362 val
= atol (interp
->result
);
368 #ifdef ANSI_PROTOTYPES
369 gdbtk_readline_begin (char *format
, ...)
371 gdbtk_readline_begin (va_alist
)
376 char buf
[200], *merge
[2];
379 #ifdef ANSI_PROTOTYPES
380 va_start (args
, format
);
384 format
= va_arg (args
, char *);
387 vsprintf (buf
, format
, args
);
388 merge
[0] = "gdbtk_tcl_readline_begin";
390 command
= Tcl_Merge (2, merge
);
391 Tcl_Eval (interp
, command
);
396 gdbtk_readline (prompt
)
407 merge
[0] = "gdbtk_tcl_readline";
409 command
= Tcl_Merge (2, merge
);
410 result
= Tcl_Eval (interp
, command
);
412 if (result
== TCL_OK
)
414 return (strdup (interp
-> result
));
418 gdbtk_fputs (interp
-> result
, gdb_stdout
);
419 gdbtk_fputs ("\n", gdb_stdout
);
425 gdbtk_readline_end ()
427 Tcl_Eval (interp
, "gdbtk_tcl_readline_end");
433 Tcl_Eval (interp
, "gdbtk_pc_changed");
438 #ifdef ANSI_PROTOTYPES
439 dsprintf_append_element (Tcl_DString
*dsp
, char *format
, ...)
441 dsprintf_append_element (va_alist
)
448 #ifdef ANSI_PROTOTYPES
449 va_start (args
, format
);
455 dsp
= va_arg (args
, Tcl_DString
*);
456 format
= va_arg (args
, char *);
459 vsprintf (buf
, format
, args
);
461 Tcl_DStringAppendElement (dsp
, buf
);
465 gdb_path_conv (clientData
, interp
, argc
, argv
)
466 ClientData clientData
;
472 char pathname
[256], *ptr
;
474 error ("wrong # args");
475 cygwin32_conv_to_full_win32_path (argv
[1], pathname
);
476 for (ptr
= pathname
; *ptr
; ptr
++)
482 char *pathname
= argv
[1];
484 Tcl_DStringAppend (result_ptr
, pathname
, strlen(pathname
));
489 gdb_get_breakpoint_list (clientData
, interp
, argc
, argv
)
490 ClientData clientData
;
495 struct breakpoint
*b
;
496 extern struct breakpoint
*breakpoint_chain
;
499 error ("wrong # args");
501 for (b
= breakpoint_chain
; b
; b
= b
->next
)
502 if (b
->type
== bp_breakpoint
)
503 dsprintf_append_element (result_ptr
, "%d", b
->number
);
509 gdb_get_breakpoint_info (clientData
, interp
, argc
, argv
)
510 ClientData clientData
;
515 struct symtab_and_line sal
;
516 static char *bptypes
[] = {"breakpoint", "hardware breakpoint", "until",
517 "finish", "watchpoint", "hardware watchpoint",
518 "read watchpoint", "access watchpoint",
519 "longjmp", "longjmp resume", "step resume",
520 "through sigtramp", "watchpoint scope",
522 static char *bpdisp
[] = {"delete", "delstop", "disable", "donttouch"};
523 struct command_line
*cmd
;
525 struct breakpoint
*b
;
526 extern struct breakpoint
*breakpoint_chain
;
527 char *funcname
, *fname
, *filename
;
530 error ("wrong # args");
532 bpnum
= atoi (argv
[1]);
534 for (b
= breakpoint_chain
; b
; b
= b
->next
)
535 if (b
->number
== bpnum
)
538 if (!b
|| b
->type
!= bp_breakpoint
)
539 error ("Breakpoint #%d does not exist", bpnum
);
541 sal
= find_pc_line (b
->address
, 0);
543 filename
= symtab_to_filename (sal
.symtab
);
544 if (filename
== NULL
)
546 Tcl_DStringAppendElement (result_ptr
, filename
);
548 find_pc_partial_function (b
->address
, &funcname
, NULL
, NULL
);
549 fname
= cplus_demangle (funcname
, 0);
552 Tcl_DStringAppendElement (result_ptr
, fname
);
556 Tcl_DStringAppendElement (result_ptr
, funcname
);
557 dsprintf_append_element (result_ptr
, "%d", b
->line_number
);
558 dsprintf_append_element (result_ptr
, "0x%lx", b
->address
);
559 Tcl_DStringAppendElement (result_ptr
, bptypes
[b
->type
]);
560 Tcl_DStringAppendElement (result_ptr
, b
->enable
== enabled
? "1" : "0");
561 Tcl_DStringAppendElement (result_ptr
, bpdisp
[b
->disposition
]);
562 dsprintf_append_element (result_ptr
, "%d", b
->ignore_count
);
564 Tcl_DStringStartSublist (result_ptr
);
565 for (cmd
= b
->commands
; cmd
; cmd
= cmd
->next
)
566 Tcl_DStringAppendElement (result_ptr
, cmd
->line
);
567 Tcl_DStringEndSublist (result_ptr
);
569 Tcl_DStringAppendElement (result_ptr
, b
->cond_string
);
571 dsprintf_append_element (result_ptr
, "%d", b
->thread
);
572 dsprintf_append_element (result_ptr
, "%d", b
->hit_count
);
578 breakpoint_notify(b
, action
)
579 struct breakpoint
*b
;
584 struct symtab_and_line sal
;
587 if (b
->type
!= bp_breakpoint
)
590 /* We ensure that ACTION contains no special Tcl characters, so we
592 sal
= find_pc_line (b
->address
, 0);
593 filename
= symtab_to_filename (sal
.symtab
);
594 if (filename
== NULL
)
597 sprintf (buf
, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action
, b
->number
,
598 (long)b
->address
, b
->line_number
, filename
);
600 v
= Tcl_Eval (interp
, buf
);
604 gdbtk_fputs (interp
->result
, gdb_stdout
);
605 gdbtk_fputs ("\n", gdb_stdout
);
610 gdbtk_create_breakpoint(b
)
611 struct breakpoint
*b
;
613 breakpoint_notify (b
, "create");
617 gdbtk_delete_breakpoint(b
)
618 struct breakpoint
*b
;
620 breakpoint_notify (b
, "delete");
624 gdbtk_modify_breakpoint(b
)
625 struct breakpoint
*b
;
627 breakpoint_notify (b
, "modify");
630 /* This implements the TCL command `gdb_loc', which returns a list */
631 /* consisting of the following: */
632 /* basename, function name, filename, line number, address, current pc */
635 gdb_loc (clientData
, interp
, argc
, argv
)
636 ClientData clientData
;
642 struct symtab_and_line sal
;
643 char *funcname
, *fname
;
646 if (!have_full_symbols () && !have_partial_symbols ())
648 Tcl_SetResult (interp
, "No symbol table is loaded", TCL_STATIC
);
654 if (selected_frame
&& (selected_frame
->pc
!= stop_pc
))
656 /* Note - this next line is not correct on all architectures. */
657 /* For a graphical debugged we really want to highlight the */
658 /* assembly line that called the next function on the stack. */
659 /* Many architectures have the next instruction saved as the */
660 /* pc on the stack, so what happens is the next instruction is hughlighted. */
662 pc
= selected_frame
->pc
;
663 sal
= find_pc_line (selected_frame
->pc
,
664 selected_frame
->next
!= NULL
665 && !selected_frame
->next
->signal_handler_caller
666 && !frame_in_dummy (selected_frame
->next
));
671 sal
= find_pc_line (stop_pc
, 0);
676 struct symtabs_and_lines sals
;
679 sals
= decode_line_spec (argv
[1], 1);
686 error ("Ambiguous line spec");
691 error ("wrong # args");
694 Tcl_DStringAppendElement (result_ptr
, sal
.symtab
->filename
);
696 Tcl_DStringAppendElement (result_ptr
, "");
698 find_pc_partial_function (pc
, &funcname
, NULL
, NULL
);
699 fname
= cplus_demangle (funcname
, 0);
702 Tcl_DStringAppendElement (result_ptr
, fname
);
706 Tcl_DStringAppendElement (result_ptr
, funcname
);
707 filename
= symtab_to_filename (sal
.symtab
);
708 if (filename
== NULL
)
711 Tcl_DStringAppendElement (result_ptr
, filename
);
712 dsprintf_append_element (result_ptr
, "%d", sal
.line
); /* line number */
713 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(pc
)); /* PC in current frame */
714 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(stop_pc
)); /* Real PC */
718 /* This implements the TCL command `gdb_eval'. */
721 gdb_eval (clientData
, interp
, argc
, argv
)
722 ClientData clientData
;
727 struct expression
*expr
;
728 struct cleanup
*old_chain
;
732 error ("wrong # args");
734 expr
= parse_expression (argv
[1]);
736 old_chain
= make_cleanup (free_current_contents
, &expr
);
738 val
= evaluate_expression (expr
);
740 val_print (VALUE_TYPE (val
), VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
741 gdb_stdout
, 0, 0, 0, 0);
743 do_cleanups (old_chain
);
748 /* gdb_get_mem addr form size num aschar*/
749 /* dump a block of memory */
750 /* addr: address of data to dump */
751 /* form: a char indicating format */
752 /* size: size of each element; 1,2,4, or 8 bytes*/
753 /* num: the number of bytes to read */
754 /* acshar: an optional ascii character to use in ASCII dump */
755 /* returns a list of elements followed by an optional */
759 gdb_get_mem (clientData
, interp
, argc
, argv
)
760 ClientData clientData
;
765 int size
, asize
, i
, j
, bc
;
767 int nbytes
, rnum
, bpr
;
768 char format
, c
, *ptr
, buff
[128], aschar
, *mbuf
, *mptr
, *cptr
, *bptr
;
769 struct type
*val_type
;
771 if (argc
< 6 || argc
> 7)
773 interp
->result
= "addr format size bytes bytes_per_row ?ascii_char?";
777 size
= (int)strtoul(argv
[3],(char **)NULL
,0);
778 nbytes
= (int)strtoul(argv
[4],(char **)NULL
,0);
779 bpr
= (int)strtoul(argv
[5],(char **)NULL
,0);
780 if (nbytes
<= 0 || bpr
<= 0 || size
<= 0)
782 interp
->result
= "Invalid number of bytes.";
786 addr
= (CORE_ADDR
)strtoul(argv
[1],(char **)NULL
,0);
788 mbuf
= (char *)malloc (nbytes
+32);
791 interp
->result
= "Out of memory.";
794 memset (mbuf
, 0, nbytes
+32);
797 rnum
= target_read_memory_partial (addr
, mbuf
, nbytes
, NULL
);
806 val_type
= builtin_type_char
;
810 val_type
= builtin_type_short
;
814 val_type
= builtin_type_int
;
818 val_type
= builtin_type_long_long
;
822 val_type
= builtin_type_char
;
826 bc
= 0; /* count of bytes in a row */
827 buff
[0] = '"'; /* buffer for ascii dump */
828 bptr
= &buff
[1]; /* pointer for ascii dump */
830 for (i
=0; i
< nbytes
; i
+= size
)
834 fputs_unfiltered ("N/A ", gdb_stdout
);
836 for ( j
= 0; j
< size
; j
++)
841 print_scalar_formatted (mptr
, val_type
, format
, asize
, gdb_stdout
);
842 fputs_unfiltered (" ", gdb_stdout
);
845 for ( j
= 0; j
< size
; j
++)
848 if (c
< 32 || c
> 126)
860 if (aschar
&& (bc
>= bpr
))
862 /* end of row. print it and reset variables */
867 fputs_unfiltered (buff
, gdb_stdout
);
877 map_arg_registers (argc
, argv
, func
, argp
)
880 void (*func
) PARAMS ((int regnum
, void *argp
));
885 /* Note that the test for a valid register must include checking the
886 reg_names array because NUM_REGS may be allocated for the union of the
887 register sets within a family of related processors. In this case, the
888 trailing entries of reg_names will change depending upon the particular
889 processor being debugged. */
891 if (argc
== 0) /* No args, just do all the regs */
895 && reg_names
[regnum
] != NULL
896 && *reg_names
[regnum
] != '\000';
903 /* Else, list of register #s, just do listed regs */
904 for (; argc
> 0; argc
--, argv
++)
906 regnum
= atoi (*argv
);
910 && reg_names
[regnum
] != NULL
911 && *reg_names
[regnum
] != '\000')
914 error ("bad register number");
921 get_register_name (regnum
, argp
)
923 void *argp
; /* Ignored */
925 Tcl_DStringAppendElement (result_ptr
, reg_names
[regnum
]);
928 /* This implements the TCL command `gdb_regnames', which returns a list of
929 all of the register names. */
932 gdb_regnames (clientData
, interp
, argc
, argv
)
933 ClientData clientData
;
941 return map_arg_registers (argc
, argv
, get_register_name
, NULL
);
944 #ifndef REGISTER_CONVERTIBLE
945 #define REGISTER_CONVERTIBLE(x) (0 != 0)
948 #ifndef REGISTER_CONVERT_TO_VIRTUAL
949 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
952 #ifndef INVALID_FLOAT
953 #define INVALID_FLOAT(x, y) (0 != 0)
957 get_register (regnum
, fp
)
961 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
962 char virtual_buffer
[MAX_REGISTER_VIRTUAL_SIZE
];
963 int format
= (int)fp
;
968 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
970 Tcl_DStringAppendElement (result_ptr
, "Optimized out");
974 /* Convert raw data to virtual format if necessary. */
976 if (REGISTER_CONVERTIBLE (regnum
))
978 REGISTER_CONVERT_TO_VIRTUAL (regnum
, REGISTER_VIRTUAL_TYPE (regnum
),
979 raw_buffer
, virtual_buffer
);
982 memcpy (virtual_buffer
, raw_buffer
, REGISTER_VIRTUAL_SIZE (regnum
));
987 printf_filtered ("0x");
988 for (j
= 0; j
< REGISTER_RAW_SIZE (regnum
); j
++)
990 register int idx
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? j
991 : REGISTER_RAW_SIZE (regnum
) - 1 - j
;
992 printf_filtered ("%02x", (unsigned char)raw_buffer
[idx
]);
996 val_print (REGISTER_VIRTUAL_TYPE (regnum
), virtual_buffer
, 0,
997 gdb_stdout
, format
, 1, 0, Val_pretty_default
);
999 Tcl_DStringAppend (result_ptr
, " ", -1);
1003 get_pc_register (clientData
, interp
, argc
, argv
)
1004 ClientData clientData
;
1009 sprintf(interp
->result
,"0x%llx",(long long)read_register(PC_REGNUM
));
1014 gdb_fetch_registers (clientData
, interp
, argc
, argv
)
1015 ClientData clientData
;
1023 error ("wrong # args");
1029 return map_arg_registers (argc
, argv
, get_register
, (void *) format
);
1032 /* This contains the previous values of the registers, since the last call to
1033 gdb_changed_register_list. */
1035 static char old_regs
[REGISTER_BYTES
];
1038 register_changed_p (regnum
, argp
)
1040 void *argp
; /* Ignored */
1042 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
1044 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
1047 if (memcmp (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1048 REGISTER_RAW_SIZE (regnum
)) == 0)
1051 /* Found a changed register. Save new value and return its number. */
1053 memcpy (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1054 REGISTER_RAW_SIZE (regnum
));
1056 dsprintf_append_element (result_ptr
, "%d", regnum
);
1060 gdb_changed_register_list (clientData
, interp
, argc
, argv
)
1061 ClientData clientData
;
1069 return map_arg_registers (argc
, argv
, register_changed_p
, NULL
);
1072 /* This implements the tcl command "gdb_immediate", which does exactly
1073 the same thing as gdb_cmd, except NONE of its outut is buffered. */
1074 /* This will also ALWAYS cause the busy,update, and idle hooks to be
1075 called, contrasted with gdb_cmd, which NEVER calls them. */
1077 gdb_immediate_command (clientData
, interp
, argc
, argv
)
1078 ClientData clientData
;
1083 Tcl_DString
*save_ptr
= NULL
;
1086 error ("wrong # args");
1088 if (running_now
|| load_in_progress
)
1093 Tcl_DStringAppend (result_ptr
, "", -1);
1094 save_ptr
= result_ptr
;
1097 execute_command (argv
[1], 1);
1099 bpstat_do_actions (&stop_bpstat
);
1101 result_ptr
= save_ptr
;
1106 /* This implements the TCL command `gdb_cmd', which sends its argument into
1107 the GDB command scanner. */
1108 /* This command will never cause the update, idle and busy hooks to be called
1111 gdb_cmd (clientData
, interp
, argc
, argv
)
1112 ClientData clientData
;
1117 Tcl_DString
*save_ptr
= NULL
;
1120 error ("wrong # args");
1122 if (running_now
|| load_in_progress
)
1127 /* for the load instruction (and possibly others later) we
1128 set result_ptr to NULL so gdbtk_fputs() will not buffer
1129 all the data until the command is finished. */
1131 if (strncmp ("load ", argv
[1], 5) == 0
1132 || strncmp ("while ", argv
[1], 6) == 0)
1134 Tcl_DStringAppend (result_ptr
, "", -1);
1135 save_ptr
= result_ptr
;
1137 load_in_progress
= 1;
1138 gdbtk_start_timer ();
1141 execute_command (argv
[1], 1);
1143 if (load_in_progress
)
1145 gdbtk_stop_timer ();
1146 load_in_progress
= 0;
1149 bpstat_do_actions (&stop_bpstat
);
1152 result_ptr
= save_ptr
;
1157 /* Client of call_wrapper - this routine performs the actual call to
1158 the client function. */
1160 struct wrapped_call_args
1171 struct wrapped_call_args
*args
;
1173 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->argc
, args
->argv
);
1177 struct wrapped_call_objs
1187 wrapped_obj_call (args
)
1188 struct wrapped_call_objs
*args
;
1190 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->objc
, args
->objv
);
1194 /* This routine acts as a top-level for all GDB code called by tcl/Tk. It
1195 handles cleanups, and calls to return_to_top_level (usually via error).
1196 This is necessary in order to prevent a longjmp out of the bowels of Tk,
1197 possibly leaving things in a bad state. Since this routine can be called
1198 recursively, it needs to save and restore the contents of the jmp_buf as
1202 call_wrapper (clientData
, interp
, argc
, argv
)
1203 ClientData clientData
;
1208 struct wrapped_call_args wrapped_args
;
1209 Tcl_DString result
, *old_result_ptr
;
1210 Tcl_DString error_string
, *old_error_string_ptr
;
1212 Tcl_DStringInit (&result
);
1213 old_result_ptr
= result_ptr
;
1214 result_ptr
= &result
;
1216 Tcl_DStringInit (&error_string
);
1217 old_error_string_ptr
= error_string_ptr
;
1218 error_string_ptr
= &error_string
;
1220 wrapped_args
.func
= (Tcl_CmdProc
*)clientData
;
1221 wrapped_args
.interp
= interp
;
1222 wrapped_args
.argc
= argc
;
1223 wrapped_args
.argv
= argv
;
1224 wrapped_args
.val
= 0;
1226 if (!catch_errors (wrapped_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
1228 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
1230 /* Make sure the timer interrupts are turned off. */
1231 if (gdbtk_timer_going
)
1232 gdbtk_stop_timer ();
1234 gdb_flush (gdb_stderr
); /* Flush error output */
1235 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
1237 /* In case of an error, we may need to force the GUI into idle
1238 mode because gdbtk_call_command may have bombed out while in
1239 the command routine. */
1242 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1245 /* do not suppress any errors -- a remote target could have errored */
1246 load_in_progress
= 0;
1248 if (Tcl_DStringLength (&error_string
) == 0)
1250 Tcl_DStringResult (interp
, &result
);
1251 Tcl_DStringFree (&error_string
);
1253 else if (Tcl_DStringLength (&result
) == 0)
1255 Tcl_DStringResult (interp
, &error_string
);
1256 Tcl_DStringFree (&result
);
1257 Tcl_DStringFree (&error_string
);
1261 Tcl_ResetResult (interp
);
1262 Tcl_AppendResult (interp
, Tcl_DStringValue (&result
),
1263 Tcl_DStringValue (&error_string
), (char *) NULL
);
1264 Tcl_DStringFree (&result
);
1265 Tcl_DStringFree (&error_string
);
1268 result_ptr
= old_result_ptr
;
1269 error_string_ptr
= old_error_string_ptr
;
1275 return wrapped_args
.val
;
1278 call_obj_wrapper (clientData
, interp
, objc
, objv
)
1279 ClientData clientData
;
1282 Tcl_Obj
*CONST objv
[];
1284 struct wrapped_call_objs wrapped_args
;
1285 Tcl_DString result
, *old_result_ptr
;
1286 Tcl_DString error_string
, *old_error_string_ptr
;
1288 /* The obj call wrapper works differently from the string wrapper, because
1289 * the obj calls currently insert their results directly into the
1290 * interpreter's result. So there is no need to have a result_ptr...
1291 * FIXME - rewrite all the object commands so they use a result_obj_ptr
1292 * - rewrite all the string commands to be object commands.
1295 Tcl_DStringInit (&result
);
1296 old_result_ptr
= result_ptr
;
1297 result_ptr
= &result
;
1299 Tcl_DStringInit (&error_string
);
1301 Tcl_DStringInit (&error_string
);
1302 old_error_string_ptr
= error_string_ptr
;
1303 error_string_ptr
= &error_string
;
1305 wrapped_args
.func
= (Tcl_CmdProc
*)clientData
;
1306 wrapped_args
.interp
= interp
;
1307 wrapped_args
.objc
= objc
;
1308 wrapped_args
.objv
= objv
;
1309 wrapped_args
.val
= 0;
1311 if (!catch_errors (wrapped_obj_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
1313 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
1315 /* Make sure the timer interrupts are turned off. */
1316 if (gdbtk_timer_going
)
1317 gdbtk_stop_timer ();
1319 gdb_flush (gdb_stderr
); /* Flush error output */
1320 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
1322 /* In case of an error, we may need to force the GUI into idle
1323 mode because gdbtk_call_command may have bombed out while in
1324 the command routine. */
1327 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1330 /* do not suppress any errors -- a remote target could have errored */
1331 load_in_progress
= 0;
1333 if (Tcl_DStringLength (&error_string
) == 0)
1335 /* We should insert the result here, but the obj commands now
1336 * do this directly, so we don't need to.
1337 * FIXME - ultimately, all this should be redone so that all the
1338 * commands either manipulate the Tcl result directly, or use a result_ptr.
1341 Tcl_DStringFree (&error_string
);
1343 else if (*(Tcl_GetStringResult (interp
)) == '\0')
1345 Tcl_DStringResult (interp
, &error_string
);
1346 Tcl_DStringFree (&error_string
);
1350 Tcl_AppendToObj(Tcl_GetObjResult(interp
), Tcl_DStringValue (&error_string
),
1351 Tcl_DStringLength (&error_string
));
1352 Tcl_DStringFree (&error_string
);
1355 result_ptr
= old_result_ptr
;
1356 error_string_ptr
= old_error_string_ptr
;
1362 return wrapped_args
.val
;
1366 comp_files (file1
, file2
)
1367 const char *file1
[], *file2
[];
1369 return strcmp(*file1
,*file2
);
1373 gdb_listfiles (clientData
, interp
, objc
, objv
)
1374 ClientData clientData
;
1377 Tcl_Obj
*CONST objv
[];
1379 struct objfile
*objfile
;
1380 struct partial_symtab
*psymtab
;
1381 struct symtab
*symtab
;
1382 char *lastfile
, *pathname
, **files
;
1384 int i
, numfiles
= 0, len
= 0;
1388 files
= (char **) xmalloc (sizeof (char *) * files_size
);
1392 Tcl_WrongNumArgs (interp
, 1, objv
, "Usage: gdb_listfiles ?pathname?");
1396 pathname
= Tcl_GetStringFromObj (objv
[1], &len
);
1398 mylist
= Tcl_NewListObj (0, NULL
);
1400 ALL_PSYMTABS (objfile
, psymtab
)
1402 if (numfiles
== files_size
)
1404 files_size
= files_size
* 2;
1405 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1409 if (psymtab
->filename
)
1410 files
[numfiles
++] = basename(psymtab
->filename
);
1412 else if (!strcmp(psymtab
->filename
,basename(psymtab
->filename
))
1413 || !strncmp(pathname
,psymtab
->filename
,len
))
1414 if (psymtab
->filename
)
1415 files
[numfiles
++] = basename(psymtab
->filename
);
1418 ALL_SYMTABS (objfile
, symtab
)
1420 if (numfiles
== files_size
)
1422 files_size
= files_size
* 2;
1423 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1427 if (symtab
->filename
)
1428 files
[numfiles
++] = basename(symtab
->filename
);
1430 else if (!strcmp(symtab
->filename
,basename(symtab
->filename
))
1431 || !strncmp(pathname
,symtab
->filename
,len
))
1432 if (symtab
->filename
)
1433 files
[numfiles
++] = basename(symtab
->filename
);
1436 qsort (files
, numfiles
, sizeof(char *), comp_files
);
1439 for (i
= 0; i
< numfiles
; i
++)
1441 if (strcmp(files
[i
],lastfile
))
1442 Tcl_ListObjAppendElement (interp
, mylist
, Tcl_NewStringObj(files
[i
], -1));
1443 lastfile
= files
[i
];
1445 Tcl_SetObjResult (interp
, mylist
);
1451 gdb_listfuncs (clientData
, interp
, argc
, argv
)
1452 ClientData clientData
;
1457 struct symtab
*symtab
;
1458 struct blockvector
*bv
;
1465 error ("wrong # args");
1467 symtab
= full_lookup_symtab (argv
[1]);
1469 error ("No such file");
1471 bv
= BLOCKVECTOR (symtab
);
1472 for (i
= GLOBAL_BLOCK
; i
<= STATIC_BLOCK
; i
++)
1474 b
= BLOCKVECTOR_BLOCK (bv
, i
);
1475 /* Skip the sort if this block is always sorted. */
1476 if (!BLOCK_SHOULD_SORT (b
))
1477 sort_block_syms (b
);
1478 for (j
= 0; j
< BLOCK_NSYMS (b
); j
++)
1480 sym
= BLOCK_SYM (b
, j
);
1481 if (SYMBOL_CLASS (sym
) == LOC_BLOCK
)
1484 char *name
= cplus_demangle (SYMBOL_NAME(sym
), 0);
1487 sprintf (buf
,"{%s} 1", name
);
1490 sprintf (buf
,"{%s} 0", SYMBOL_NAME(sym
));
1491 Tcl_DStringAppendElement (result_ptr
, buf
);
1499 target_stop_wrapper (args
)
1507 gdb_stop (clientData
, interp
, argc
, argv
)
1508 ClientData clientData
;
1515 catch_errors (target_stop_wrapper
, NULL
, "",
1519 quit_flag
= 1; /* hope something sees this */
1524 /* Prepare to accept a new executable file. This is called when we
1525 want to clear away everything we know about the old file, without
1526 asking the user. The Tcl code will have already asked the user if
1527 necessary. After this is called, we should be able to run the
1528 `file' command without getting any questions. */
1531 gdb_clear_file (clientData
, interp
, argc
, argv
)
1532 ClientData clientData
;
1537 if (inferior_pid
!= 0 && target_has_execution
)
1540 target_detach (NULL
, 0);
1545 if (target_has_execution
)
1548 symbol_file_command (NULL
, 0);
1550 /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
1551 clear it here. FIXME: This seems like an abstraction violation
1558 /* Ask the user to confirm an exit request. */
1561 gdb_confirm_quit (clientData
, interp
, argc
, argv
)
1562 ClientData clientData
;
1569 ret
= quit_confirm ();
1570 Tcl_DStringAppendElement (result_ptr
, ret
? "1" : "0");
1574 /* Quit without asking for confirmation. */
1577 gdb_force_quit (clientData
, interp
, argc
, argv
)
1578 ClientData clientData
;
1583 quit_force ((char *) NULL
, 1);
1587 /* This implements the TCL command `gdb_disassemble'. */
1590 gdbtk_dis_asm_read_memory (memaddr
, myaddr
, len
, info
)
1594 disassemble_info
*info
;
1596 extern struct target_ops exec_ops
;
1600 res
= xfer_memory (memaddr
, myaddr
, len
, 0, &exec_ops
);
1611 /* We need a different sort of line table from the normal one cuz we can't
1612 depend upon implicit line-end pc's for lines. This is because of the
1613 reordering we are about to do. */
1615 struct my_line_entry
{
1622 compare_lines (mle1p
, mle2p
)
1626 struct my_line_entry
*mle1
, *mle2
;
1629 mle1
= (struct my_line_entry
*) mle1p
;
1630 mle2
= (struct my_line_entry
*) mle2p
;
1632 val
= mle1
->line
- mle2
->line
;
1637 return mle1
->start_pc
- mle2
->start_pc
;
1641 gdb_disassemble (clientData
, interp
, argc
, argv
)
1642 ClientData clientData
;
1647 CORE_ADDR pc
, low
, high
;
1648 int mixed_source_and_assembly
;
1649 static disassemble_info di
;
1650 static int di_initialized
;
1652 if (! di_initialized
)
1654 INIT_DISASSEMBLE_INFO_NO_ARCH (di
, gdb_stdout
,
1655 (fprintf_ftype
) fprintf_unfiltered
);
1656 di
.flavour
= bfd_target_unknown_flavour
;
1657 di
.memory_error_func
= dis_asm_memory_error
;
1658 di
.print_address_func
= dis_asm_print_address
;
1662 di
.mach
= tm_print_insn_info
.mach
;
1663 if (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1664 di
.endian
= BFD_ENDIAN_BIG
;
1666 di
.endian
= BFD_ENDIAN_LITTLE
;
1668 if (argc
!= 3 && argc
!= 4)
1669 error ("wrong # args");
1671 if (strcmp (argv
[1], "source") == 0)
1672 mixed_source_and_assembly
= 1;
1673 else if (strcmp (argv
[1], "nosource") == 0)
1674 mixed_source_and_assembly
= 0;
1676 error ("First arg must be 'source' or 'nosource'");
1678 low
= parse_and_eval_address (argv
[2]);
1682 if (find_pc_partial_function (low
, NULL
, &low
, &high
) == 0)
1683 error ("No function contains specified address");
1686 high
= parse_and_eval_address (argv
[3]);
1688 /* If disassemble_from_exec == -1, then we use the following heuristic to
1689 determine whether or not to do disassembly from target memory or from the
1692 If we're debugging a local process, read target memory, instead of the
1693 exec file. This makes disassembly of functions in shared libs work
1696 Else, we're debugging a remote process, and should disassemble from the
1697 exec file for speed. However, this is no good if the target modifies its
1698 code (for relocation, or whatever).
1701 if (disassemble_from_exec
== -1)
1702 if (strcmp (target_shortname
, "child") == 0
1703 || strcmp (target_shortname
, "procfs") == 0
1704 || strcmp (target_shortname
, "vxprocess") == 0)
1705 disassemble_from_exec
= 0; /* It's a child process, read inferior mem */
1707 disassemble_from_exec
= 1; /* It's remote, read the exec file */
1709 if (disassemble_from_exec
)
1710 di
.read_memory_func
= gdbtk_dis_asm_read_memory
;
1712 di
.read_memory_func
= dis_asm_read_memory
;
1714 /* If just doing straight assembly, all we need to do is disassemble
1715 everything between low and high. If doing mixed source/assembly, we've
1716 got a totally different path to follow. */
1718 if (mixed_source_and_assembly
)
1719 { /* Come here for mixed source/assembly */
1720 /* The idea here is to present a source-O-centric view of a function to
1721 the user. This means that things are presented in source order, with
1722 (possibly) out of order assembly immediately following. */
1723 struct symtab
*symtab
;
1724 struct linetable_entry
*le
;
1727 struct my_line_entry
*mle
;
1728 struct symtab_and_line sal
;
1733 symtab
= find_pc_symtab (low
); /* Assume symtab is valid for whole PC range */
1738 /* First, convert the linetable to a bunch of my_line_entry's. */
1740 le
= symtab
->linetable
->item
;
1741 nlines
= symtab
->linetable
->nitems
;
1746 mle
= (struct my_line_entry
*) alloca (nlines
* sizeof (struct my_line_entry
));
1750 /* Copy linetable entries for this function into our data structure, creating
1751 end_pc's and setting out_of_order as appropriate. */
1753 /* First, skip all the preceding functions. */
1755 for (i
= 0; i
< nlines
- 1 && le
[i
].pc
< low
; i
++) ;
1757 /* Now, copy all entries before the end of this function. */
1760 for (; i
< nlines
- 1 && le
[i
].pc
< high
; i
++)
1762 if (le
[i
].line
== le
[i
+ 1].line
1763 && le
[i
].pc
== le
[i
+ 1].pc
)
1764 continue; /* Ignore duplicates */
1766 mle
[newlines
].line
= le
[i
].line
;
1767 if (le
[i
].line
> le
[i
+ 1].line
)
1769 mle
[newlines
].start_pc
= le
[i
].pc
;
1770 mle
[newlines
].end_pc
= le
[i
+ 1].pc
;
1774 /* If we're on the last line, and it's part of the function, then we need to
1775 get the end pc in a special way. */
1780 mle
[newlines
].line
= le
[i
].line
;
1781 mle
[newlines
].start_pc
= le
[i
].pc
;
1782 sal
= find_pc_line (le
[i
].pc
, 0);
1783 mle
[newlines
].end_pc
= sal
.end
;
1787 /* Now, sort mle by line #s (and, then by addresses within lines). */
1790 qsort (mle
, newlines
, sizeof (struct my_line_entry
), compare_lines
);
1792 /* Now, for each line entry, emit the specified lines (unless they have been
1793 emitted before), followed by the assembly code for that line. */
1795 next_line
= 0; /* Force out first line */
1796 for (i
= 0; i
< newlines
; i
++)
1798 /* Print out everything from next_line to the current line. */
1800 if (mle
[i
].line
>= next_line
)
1803 print_source_lines (symtab
, next_line
, mle
[i
].line
+ 1, 0);
1805 print_source_lines (symtab
, mle
[i
].line
, mle
[i
].line
+ 1, 0);
1807 next_line
= mle
[i
].line
+ 1;
1810 for (pc
= mle
[i
].start_pc
; pc
< mle
[i
].end_pc
; )
1813 fputs_unfiltered (" ", gdb_stdout
);
1814 print_address (pc
, gdb_stdout
);
1815 fputs_unfiltered (":\t ", gdb_stdout
);
1816 pc
+= (*tm_print_insn
) (pc
, &di
);
1817 fputs_unfiltered ("\n", gdb_stdout
);
1824 for (pc
= low
; pc
< high
; )
1827 fputs_unfiltered (" ", gdb_stdout
);
1828 print_address (pc
, gdb_stdout
);
1829 fputs_unfiltered (":\t ", gdb_stdout
);
1830 pc
+= (*tm_print_insn
) (pc
, &di
);
1831 fputs_unfiltered ("\n", gdb_stdout
);
1835 gdb_flush (gdb_stdout
);
1841 tk_command (cmd
, from_tty
)
1847 struct cleanup
*old_chain
;
1849 /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1851 error_no_arg ("tcl command to interpret");
1853 retval
= Tcl_Eval (interp
, cmd
);
1855 result
= strdup (interp
->result
);
1857 old_chain
= make_cleanup (free
, result
);
1859 if (retval
!= TCL_OK
)
1862 printf_unfiltered ("%s\n", result
);
1864 do_cleanups (old_chain
);
1868 cleanup_init (ignored
)
1872 Tcl_DeleteInterp (interp
);
1876 /* Come here during long calculations to check for GUI events. Usually invoked
1877 via the QUIT macro. */
1880 gdbtk_interactive ()
1882 /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1885 /* Come here when there is activity on the X file descriptor. */
1891 static int in_x_event
= 0;
1892 static Tcl_Obj
*varname
= NULL
;
1893 if (in_x_event
|| in_fputs
)
1898 /* Process pending events */
1899 while (Tcl_DoOneEvent (TCL_DONT_WAIT
|TCL_ALL_EVENTS
) != 0)
1902 if (load_in_progress
)
1905 if (varname
== NULL
)
1907 Tcl_Obj
*varnamestrobj
= Tcl_NewStringObj("download_cancel_ok",-1);
1908 varname
= Tcl_ObjGetVar2(interp
,varnamestrobj
,NULL
,TCL_GLOBAL_ONLY
);
1910 if ((Tcl_GetIntFromObj(interp
,varname
,&val
) == TCL_OK
) && val
)
1924 /* For Cygwin32, we use a timer to periodically check for Windows
1925 messages. FIXME: It would be better to not poll, but to instead
1926 rewrite the target_wait routines to serve as input sources.
1927 Unfortunately, that will be a lot of work. */
1928 static sigset_t nullsigmask
;
1929 static struct sigaction act1
, act2
;
1930 static struct itimerval it_on
, it_off
;
1933 gdbtk_start_timer ()
1935 static int first
= 1;
1936 /*TclDebug ("Starting timer....");*/
1939 /* first time called, set up all the structs */
1941 sigemptyset (&nullsigmask
);
1943 act1
.sa_handler
= x_event
;
1944 act1
.sa_mask
= nullsigmask
;
1947 act2
.sa_handler
= SIG_IGN
;
1948 act2
.sa_mask
= nullsigmask
;
1951 it_on
.it_interval
.tv_sec
= 0;
1952 it_on
.it_interval
.tv_usec
= 250000; /* .25 sec */
1953 it_on
.it_value
.tv_sec
= 0;
1954 it_on
.it_value
.tv_usec
= 250000;
1956 it_off
.it_interval
.tv_sec
= 0;
1957 it_off
.it_interval
.tv_usec
= 0;
1958 it_off
.it_value
.tv_sec
= 0;
1959 it_off
.it_value
.tv_usec
= 0;
1962 if (!gdbtk_timer_going
)
1964 sigaction (SIGALRM
, &act1
, NULL
);
1965 setitimer (ITIMER_REAL
, &it_on
, NULL
);
1966 gdbtk_timer_going
= 1;
1973 if (gdbtk_timer_going
)
1975 gdbtk_timer_going
= 0;
1976 /*TclDebug ("Stopping timer.");*/
1977 setitimer (ITIMER_REAL
, &it_off
, NULL
);
1978 sigaction (SIGALRM
, &act2
, NULL
);
1982 /* This hook function is called whenever we want to wait for the
1986 gdbtk_wait (pid
, ourstatus
)
1988 struct target_waitstatus
*ourstatus
;
1990 gdbtk_start_timer ();
1991 pid
= target_wait (pid
, ourstatus
);
1992 gdbtk_stop_timer ();
1996 /* This is called from execute_command, and provides a wrapper around
1997 various command routines in a place where both protocol messages and
1998 user input both flow through. Mostly this is used for indicating whether
1999 the target process is running or not.
2003 gdbtk_call_command (cmdblk
, arg
, from_tty
)
2004 struct cmd_list_element
*cmdblk
;
2009 if (cmdblk
->class == class_run
|| cmdblk
->class == class_trace
)
2012 /* HACK! HACK! This is to get the gui to update the tstart/tstop
2013 button only incase of tstart/tstop commands issued from the console
2014 We don't want to update the src window, s we need to have specific
2015 procedures to do tstart and tstop
2017 if (!strcmp(cmdblk
->name
, "tstart") && !No_Update
)
2018 Tcl_Eval (interp
, "gdbtk_tcl_tstart");
2019 else if (!strcmp(cmdblk
->name
, "tstop") && !No_Update
)
2020 Tcl_Eval (interp
, "gdbtk_tcl_tstop");
2026 Tcl_Eval (interp
, "gdbtk_tcl_busy");
2027 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2030 Tcl_Eval (interp
, "gdbtk_tcl_idle");
2034 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2037 /* This function is called instead of gdb's internal command loop. This is the
2038 last chance to do anything before entering the main Tk event loop. */
2043 extern GDB_FILE
*instream
;
2045 /* We no longer want to use stdin as the command input stream */
2048 if (Tcl_Eval (interp
, "gdbtk_tcl_preloop") != TCL_OK
)
2052 /* Force errorInfo to be set up propertly. */
2053 Tcl_AddErrorInfo (interp
, "");
2055 msg
= Tcl_GetVar (interp
, "errorInfo", TCL_GLOBAL_ONLY
);
2057 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
2059 fputs_unfiltered (msg
, gdb_stderr
);
2070 /* gdbtk_init installs this function as a final cleanup. */
2073 gdbtk_cleanup (dummy
)
2077 struct ide_event_handle
*h
= (struct ide_event_handle
*) dummy
;
2079 ide_interface_deregister_all (h
);
2084 /* Initialize gdbtk. */
2087 gdbtk_init ( argv0
)
2090 struct cleanup
*old_chain
;
2091 char *lib
, *gdbtk_lib
, *gdbtk_lib_tmp
, *gdbtk_file
;
2094 struct sigaction action
;
2095 static sigset_t nullsigmask
= {0};
2098 /* start-sanitize-ide */
2099 struct ide_event_handle
*h
;
2102 /* end-sanitize-ide */
2105 /* If there is no DISPLAY environment variable, Tk_Init below will fail,
2106 causing gdb to abort. If instead we simply return here, gdb will
2107 gracefully degrade to using the command line interface. */
2110 if (getenv ("DISPLAY") == NULL
)
2114 old_chain
= make_cleanup (cleanup_init
, 0);
2116 /* First init tcl and tk. */
2117 Tcl_FindExecutable (argv0
);
2118 interp
= Tcl_CreateInterp ();
2120 #ifdef TCL_MEM_DEBUG
2121 Tcl_InitMemory (interp
);
2125 error ("Tcl_CreateInterp failed");
2127 if (Tcl_Init(interp
) != TCL_OK
)
2128 error ("Tcl_Init failed: %s", interp
->result
);
2131 /* For the IDE we register the cleanup later, after we've
2132 initialized events. */
2133 make_final_cleanup (gdbtk_cleanup
, NULL
);
2136 /* Initialize the Paths variable. */
2137 if (ide_initialize_paths (interp
, "gdbtcl") != TCL_OK
)
2138 error ("ide_initialize_paths failed: %s", interp
->result
);
2141 /* start-sanitize-ide */
2142 /* Find the directory where we expect to find idemanager. We ignore
2143 errors since it doesn't really matter if this fails. */
2144 libexecdir
= Tcl_GetVar2 (interp
, "Paths", "libexecdir", TCL_GLOBAL_ONLY
);
2148 h
= ide_event_init_from_environment (&errmsg
, libexecdir
);
2149 make_final_cleanup (gdbtk_cleanup
, h
);
2152 Tcl_AppendResult (interp
, "can't initialize event system: ", errmsg
,
2154 fprintf(stderr
, "WARNING: ide_event_init_client failed: %s\n", interp
->result
);
2156 Tcl_SetVar (interp
, "GDBTK_IDE", "0", 0);
2160 if (ide_create_tclevent_command (interp
, h
) != TCL_OK
)
2161 error ("ide_create_tclevent_command failed: %s", interp
->result
);
2163 if (ide_create_edit_command (interp
, h
) != TCL_OK
)
2164 error ("ide_create_edit_command failed: %s", interp
->result
);
2166 if (ide_create_property_command (interp
, h
) != TCL_OK
)
2167 error ("ide_create_property_command failed: %s", interp
->result
);
2169 if (ide_create_build_command (interp
, h
) != TCL_OK
)
2170 error ("ide_create_build_command failed: %s", interp
->result
);
2172 if (ide_create_window_register_command (interp
, h
, "gdb-restore")
2174 error ("ide_create_window_register_command failed: %s",
2177 if (ide_create_window_command (interp
, h
) != TCL_OK
)
2178 error ("ide_create_window_command failed: %s", interp
->result
);
2180 if (ide_create_exit_command (interp
, h
) != TCL_OK
)
2181 error ("ide_create_exit_command failed: %s", interp
->result
);
2183 if (ide_create_help_command (interp
) != TCL_OK
)
2184 error ("ide_create_help_command failed: %s", interp
->result
);
2187 if (ide_initialize (interp, "gdb") != TCL_OK)
2188 error ("ide_initialize failed: %s", interp->result);
2191 Tcl_SetVar (interp
, "GDBTK_IDE", "1", 0);
2193 /* end-sanitize-ide */
2195 Tcl_SetVar (interp
, "GDBTK_IDE", "0", 0);
2198 /* We don't want to open the X connection until we've done all the
2199 IDE initialization. Otherwise, goofy looking unfinished windows
2200 pop up when ILU drops into the TCL event loop. */
2202 if (Tk_Init(interp
) != TCL_OK
)
2203 error ("Tk_Init failed: %s", interp
->result
);
2205 if (Itcl_Init(interp
) == TCL_ERROR
)
2206 error ("Itcl_Init failed: %s", interp
->result
);
2208 if (Tix_Init(interp
) != TCL_OK
)
2209 error ("Tix_Init failed: %s", interp
->result
);
2212 if (ide_create_messagebox_command (interp
) != TCL_OK
)
2213 error ("messagebox command initialization failed");
2214 /* On Windows, create a sizebox widget command */
2215 if (ide_create_sizebox_command (interp
) != TCL_OK
)
2216 error ("sizebox creation failed");
2217 if (ide_create_winprint_command (interp
) != TCL_OK
)
2218 error ("windows print code initialization failed");
2219 /* start-sanitize-ide */
2220 /* An interface to ShellExecute. */
2221 if (ide_create_shell_execute_command (interp
) != TCL_OK
)
2222 error ("shell execute command initialization failed");
2223 /* end-sanitize-ide */
2224 if (ide_create_win_grab_command (interp
) != TCL_OK
)
2225 error ("grab support command initialization failed");
2226 /* Path conversion functions. */
2227 if (ide_create_cygwin_path_command (interp
) != TCL_OK
)
2228 error ("cygwin path command initialization failed");
2231 Tcl_CreateCommand (interp
, "gdb_cmd", call_wrapper
, gdb_cmd
, NULL
);
2232 Tcl_CreateCommand (interp
, "gdb_immediate", call_wrapper
,
2233 gdb_immediate_command
, NULL
);
2234 Tcl_CreateCommand (interp
, "gdb_loc", call_wrapper
, gdb_loc
, NULL
);
2235 Tcl_CreateCommand (interp
, "gdb_path_conv", call_wrapper
, gdb_path_conv
, NULL
);
2236 Tcl_CreateObjCommand (interp
, "gdb_listfiles", call_obj_wrapper
, gdb_listfiles
, NULL
);
2237 Tcl_CreateCommand (interp
, "gdb_listfuncs", call_wrapper
, gdb_listfuncs
,
2239 Tcl_CreateCommand (interp
, "gdb_get_mem", call_wrapper
, gdb_get_mem
,
2241 Tcl_CreateCommand (interp
, "gdb_stop", call_wrapper
, gdb_stop
, NULL
);
2242 Tcl_CreateCommand (interp
, "gdb_regnames", call_wrapper
, gdb_regnames
, NULL
);
2243 Tcl_CreateCommand (interp
, "gdb_fetch_registers", call_wrapper
,
2244 gdb_fetch_registers
, NULL
);
2245 Tcl_CreateCommand (interp
, "gdb_changed_register_list", call_wrapper
,
2246 gdb_changed_register_list
, NULL
);
2247 Tcl_CreateCommand (interp
, "gdb_disassemble", call_wrapper
,
2248 gdb_disassemble
, NULL
);
2249 Tcl_CreateCommand (interp
, "gdb_eval", call_wrapper
, gdb_eval
, NULL
);
2250 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_list", call_wrapper
,
2251 gdb_get_breakpoint_list
, NULL
);
2252 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_info", call_wrapper
,
2253 gdb_get_breakpoint_info
, NULL
);
2254 Tcl_CreateCommand (interp
, "gdb_clear_file", call_wrapper
,
2255 gdb_clear_file
, NULL
);
2256 Tcl_CreateCommand (interp
, "gdb_confirm_quit", call_wrapper
,
2257 gdb_confirm_quit
, NULL
);
2258 Tcl_CreateCommand (interp
, "gdb_force_quit", call_wrapper
,
2259 gdb_force_quit
, NULL
);
2260 Tcl_CreateCommand (interp
, "gdb_target_has_execution",
2261 gdb_target_has_execution_command
,
2263 Tcl_CreateCommand (interp
, "gdb_is_tracing",
2266 Tcl_CreateObjCommand (interp
, "gdb_load_info", call_obj_wrapper
, gdb_load_info
, NULL
);
2267 Tcl_CreateObjCommand (interp
, "gdb_get_locals", call_obj_wrapper
, gdb_get_locals_command
,
2269 Tcl_CreateObjCommand (interp
, "gdb_get_args", call_obj_wrapper
, gdb_get_args_command
,
2271 Tcl_CreateObjCommand (interp
, "gdb_get_function", call_obj_wrapper
, gdb_get_function_command
,
2273 Tcl_CreateObjCommand (interp
, "gdb_get_line", call_obj_wrapper
, gdb_get_line_command
,
2275 Tcl_CreateObjCommand (interp
, "gdb_get_file", call_obj_wrapper
, gdb_get_file_command
,
2277 Tcl_CreateObjCommand (interp
, "gdb_tracepoint_exists",
2278 call_obj_wrapper
, gdb_tracepoint_exists_command
, NULL
);
2279 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_info",
2280 call_obj_wrapper
, gdb_get_tracepoint_info
, NULL
);
2281 Tcl_CreateObjCommand (interp
, "gdb_actions",
2282 call_obj_wrapper
, gdb_actions_command
, NULL
);
2283 Tcl_CreateObjCommand (interp
, "gdb_prompt",
2284 call_obj_wrapper
, gdb_prompt_command
, NULL
);
2285 Tcl_CreateObjCommand (interp
, "gdb_find_file",
2286 call_obj_wrapper
, gdb_find_file_command
, NULL
);
2287 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_list",
2288 call_obj_wrapper
, gdb_get_tracepoint_list
, NULL
);
2289 Tcl_CreateCommand (interp
, "gdb_pc_reg", get_pc_register
, NULL
, NULL
);
2290 Tcl_CreateObjCommand (interp
, "gdb_loadfile", call_obj_wrapper
, gdb_loadfile
, NULL
);
2291 Tcl_CreateObjCommand (interp
, "gdb_set_bp", call_obj_wrapper
, gdb_set_bp
, NULL
);
2293 command_loop_hook
= tk_command_loop
;
2294 print_frame_info_listing_hook
= gdbtk_print_frame_info
;
2295 query_hook
= gdbtk_query
;
2296 warning_hook
= gdbtk_warning
;
2297 flush_hook
= gdbtk_flush
;
2298 create_breakpoint_hook
= gdbtk_create_breakpoint
;
2299 delete_breakpoint_hook
= gdbtk_delete_breakpoint
;
2300 modify_breakpoint_hook
= gdbtk_modify_breakpoint
;
2301 interactive_hook
= gdbtk_interactive
;
2302 target_wait_hook
= gdbtk_wait
;
2303 call_command_hook
= gdbtk_call_command
;
2304 readline_begin_hook
= gdbtk_readline_begin
;
2305 readline_hook
= gdbtk_readline
;
2306 readline_end_hook
= gdbtk_readline_end
;
2307 ui_load_progress_hook
= gdbtk_load_hash
;
2308 pre_add_symbol_hook
= gdbtk_pre_add_symbol
;
2309 post_add_symbol_hook
= gdbtk_post_add_symbol
;
2310 create_tracepoint_hook
= gdbtk_create_tracepoint
;
2311 delete_tracepoint_hook
= gdbtk_delete_tracepoint
;
2312 modify_tracepoint_hook
= gdbtk_modify_tracepoint
;
2313 pc_changed_hook
= pc_changed
;
2315 add_com ("tk", class_obscure
, tk_command
,
2316 "Send a command directly into tk.");
2318 Tcl_LinkVar (interp
, "disassemble-from-exec", (char *)&disassemble_from_exec
,
2321 /* find the gdb tcl library and source main.tcl */
2323 gdbtk_lib
= getenv ("GDBTK_LIBRARY");
2325 if (access ("gdbtcl/main.tcl", R_OK
) == 0)
2326 gdbtk_lib
= "gdbtcl";
2328 gdbtk_lib
= GDBTK_LIBRARY
;
2330 gdbtk_lib_tmp
= xstrdup (gdbtk_lib
);
2333 /* see if GDBTK_LIBRARY is a path list */
2334 lib
= strtok (gdbtk_lib_tmp
, GDBTK_PATH_SEP
);
2337 if (Tcl_VarEval (interp
, "lappend auto_path ", lib
, NULL
) != TCL_OK
)
2339 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
2344 gdbtk_file
= concat (lib
, "/main.tcl", (char *) NULL
);
2345 if (access (gdbtk_file
, R_OK
) == 0)
2348 Tcl_SetVar (interp
, "GDBTK_LIBRARY", lib
, 0);
2352 while ((lib
= strtok (NULL
, ":")) != NULL
);
2354 free (gdbtk_lib_tmp
);
2358 /* Try finding it with the auto path. */
2360 static const char script
[] ="\
2361 proc gdbtk_find_main {} {\n\
2362 global auto_path GDBTK_LIBRARY\n\
2363 foreach dir $auto_path {\n\
2364 set f [file join $dir main.tcl]\n\
2365 if {[file exists $f]} then {\n\
2366 set GDBTK_LIBRARY $dir\n\
2374 if (Tcl_GlobalEval (interp
, (char *) script
) != TCL_OK
)
2376 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
2380 if (interp
->result
[0] != '\0')
2382 gdbtk_file
= xstrdup (interp
->result
);
2389 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
2390 if (getenv("GDBTK_LIBRARY"))
2392 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
2393 fprintf_unfiltered (stderr
,
2394 "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
2398 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY
);
2399 fprintf_unfiltered (stderr
, "You might want to set GDBTK_LIBRARY\n");
2404 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
2405 prior to this point go to stdout/stderr. */
2407 fputs_unfiltered_hook
= gdbtk_fputs
;
2409 if (Tcl_EvalFile (interp
, gdbtk_file
) != TCL_OK
)
2413 /* Force errorInfo to be set up propertly. */
2414 Tcl_AddErrorInfo (interp
, "");
2416 msg
= Tcl_GetVar (interp
, "errorInfo", TCL_GLOBAL_ONLY
);
2418 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
2421 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
2423 fputs_unfiltered (msg
, gdb_stderr
);
2430 /* start-sanitize-ide */
2431 /* Don't do this until we have initialized. Otherwise, we may get a
2432 run command before we are ready for one. */
2433 if (ide_run_server_init (interp
, h
) != TCL_OK
)
2434 error ("ide_run_server_init failed: %s", interp
->result
);
2435 /* end-sanitize-ide */
2440 discard_cleanups (old_chain
);
2444 gdb_target_has_execution_command (clientData
, interp
, argc
, argv
)
2445 ClientData clientData
;
2452 if (target_has_execution
&& inferior_pid
!= 0)
2455 Tcl_SetIntObj (Tcl_GetObjResult (interp
), result
);
2460 gdb_trace_status (clientData
, interp
, argc
, argv
)
2461 ClientData clientData
;
2468 if (trace_running_p
)
2471 Tcl_SetIntObj (Tcl_GetObjResult (interp
), result
);
2475 /* gdb_load_info - returns information about the file about to be downloaded */
2478 gdb_load_info (clientData
, interp
, objc
, objv
)
2479 ClientData clientData
;
2482 Tcl_Obj
*CONST objv
[];
2485 struct cleanup
*old_cleanups
;
2491 char *filename
= Tcl_GetStringFromObj (objv
[1], NULL
);
2493 loadfile_bfd
= bfd_openr (filename
, gnutarget
);
2494 if (loadfile_bfd
== NULL
)
2496 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("Open failed", -1));
2499 old_cleanups
= make_cleanup (bfd_close
, loadfile_bfd
);
2501 if (!bfd_check_format (loadfile_bfd
, bfd_object
))
2503 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("Bad Object File", -1));
2507 for (s
= loadfile_bfd
->sections
; s
; s
= s
->next
)
2509 if (s
->flags
& SEC_LOAD
)
2511 bfd_size_type size
= bfd_get_section_size_before_reloc (s
);
2514 ob
[0] = Tcl_NewStringObj((char *)bfd_get_section_name(loadfile_bfd
, s
), -1);
2515 ob
[1] = Tcl_NewLongObj ((long)size
);
2516 res
[i
++] = Tcl_NewListObj (2, ob
);
2521 Tcl_SetObjResult (interp
, Tcl_NewListObj (i
, res
));
2522 do_cleanups (old_cleanups
);
2528 gdbtk_load_hash (section
, num
)
2533 sprintf (buf
, "download_hash %s %ld", section
, num
);
2534 Tcl_Eval (interp
, buf
);
2535 return atoi (interp
->result
);
2539 * This and gdb_get_locals just call gdb_get_vars_command with the right
2540 * value of clientData. We can't use the client data in the definition
2541 * of the command, because the call wrapper uses this instead...
2545 gdb_get_locals_command (clientData
, interp
, objc
, objv
)
2546 ClientData clientData
;
2549 Tcl_Obj
*CONST objv
[];
2552 return gdb_get_vars_command((ClientData
) 0, interp
, objc
, objv
);
2557 gdb_get_args_command (clientData
, interp
, objc
, objv
)
2558 ClientData clientData
;
2561 Tcl_Obj
*CONST objv
[];
2564 return gdb_get_vars_command((ClientData
) 1, interp
, objc
, objv
);
2568 /* gdb_get_vars_command -
2570 * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
2571 * function sets the Tcl interpreter's result to a list of variable names
2572 * depending on clientData. If clientData is one, the result is a list of
2573 * arguments; zero returns a list of locals -- all relative to the block
2574 * specified as an argument to the command. Valid commands include
2575 * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
2579 gdb_get_vars_command (clientData
, interp
, objc
, objv
)
2580 ClientData clientData
;
2583 Tcl_Obj
*CONST objv
[];
2586 struct symtabs_and_lines sals
;
2588 struct block
*block
;
2589 char **canonical
, *args
;
2590 int i
, nsyms
, arguments
;
2594 Tcl_AppendResult (interp
,
2595 "wrong # of args: should be \"",
2596 Tcl_GetStringFromObj (objv
[0], NULL
),
2597 " function:line|function|line|*addr\"");
2601 arguments
= (int) clientData
;
2602 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2603 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2604 if (sals
.nelts
== 0)
2606 Tcl_AppendResult (interp
,
2607 "error decoding line", NULL
);
2611 /* Initialize a list that will hold the results */
2612 result
= Tcl_NewListObj (0, NULL
);
2614 /* Resolve all line numbers to PC's */
2615 for (i
= 0; i
< sals
.nelts
; i
++)
2616 resolve_sal_pc (&sals
.sals
[i
]);
2618 block
= block_for_pc (sals
.sals
[0].pc
);
2621 nsyms
= BLOCK_NSYMS (block
);
2622 for (i
= 0; i
< nsyms
; i
++)
2624 sym
= BLOCK_SYM (block
, i
);
2625 switch (SYMBOL_CLASS (sym
)) {
2627 case LOC_UNDEF
: /* catches errors */
2628 case LOC_CONST
: /* constant */
2629 case LOC_STATIC
: /* static */
2630 case LOC_REGISTER
: /* register */
2631 case LOC_TYPEDEF
: /* local typedef */
2632 case LOC_LABEL
: /* local label */
2633 case LOC_BLOCK
: /* local function */
2634 case LOC_CONST_BYTES
: /* loc. byte seq. */
2635 case LOC_UNRESOLVED
: /* unresolved static */
2636 case LOC_OPTIMIZED_OUT
: /* optimized out */
2638 case LOC_ARG
: /* argument */
2639 case LOC_REF_ARG
: /* reference arg */
2640 case LOC_REGPARM
: /* register arg */
2641 case LOC_REGPARM_ADDR
: /* indirect register arg */
2642 case LOC_LOCAL_ARG
: /* stack arg */
2643 case LOC_BASEREG_ARG
: /* basereg arg */
2645 Tcl_ListObjAppendElement (interp
, result
,
2646 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
2648 case LOC_LOCAL
: /* stack local */
2649 case LOC_BASEREG
: /* basereg local */
2651 Tcl_ListObjAppendElement (interp
, result
,
2652 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
2656 if (BLOCK_FUNCTION (block
))
2659 block
= BLOCK_SUPERBLOCK (block
);
2662 Tcl_SetObjResult (interp
, result
);
2667 gdb_get_line_command (clientData
, interp
, objc
, objv
)
2668 ClientData clientData
;
2671 Tcl_Obj
*CONST objv
[];
2674 struct symtabs_and_lines sals
;
2675 char *args
, **canonical
;
2679 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2680 Tcl_GetStringFromObj (objv
[0], NULL
),
2685 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2686 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2687 if (sals
.nelts
== 1)
2689 Tcl_SetObjResult (interp
, Tcl_NewIntObj (sals
.sals
[0].line
));
2693 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2698 gdb_get_file_command (clientData
, interp
, objc
, objv
)
2699 ClientData clientData
;
2702 Tcl_Obj
*CONST objv
[];
2705 struct symtabs_and_lines sals
;
2706 char *args
, **canonical
;
2710 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2711 Tcl_GetStringFromObj (objv
[0], NULL
),
2716 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2717 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2718 if (sals
.nelts
== 1)
2720 Tcl_SetResult (interp
, sals
.sals
[0].symtab
->filename
, TCL_VOLATILE
);
2724 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2729 gdb_get_function_command (clientData
, interp
, objc
, objv
)
2730 ClientData clientData
;
2733 Tcl_Obj
*CONST objv
[];
2737 struct symtabs_and_lines sals
;
2738 char *args
, **canonical
;
2742 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2743 Tcl_GetStringFromObj (objv
[0], NULL
),
2748 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2749 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2750 if (sals
.nelts
== 1)
2752 resolve_sal_pc (&sals
.sals
[0]);
2753 find_pc_partial_function (sals
.sals
[0].pc
, &function
, NULL
, NULL
);
2754 if (function
!= NULL
)
2756 Tcl_SetResult (interp
, function
, TCL_VOLATILE
);
2761 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2766 gdb_get_tracepoint_info (clientData
, interp
, objc
, objv
)
2767 ClientData clientData
;
2770 Tcl_Obj
*CONST objv
[];
2772 struct symtab_and_line sal
;
2774 struct tracepoint
*tp
;
2775 struct action_line
*al
;
2776 Tcl_Obj
*list
, *action_list
;
2777 char *filename
, *funcname
;
2781 error ("wrong # args");
2783 Tcl_GetIntFromObj (NULL
, objv
[1], &tpnum
);
2785 ALL_TRACEPOINTS (tp
)
2786 if (tp
->number
== tpnum
)
2790 error ("Tracepoint #%d does not exist", tpnum
);
2792 list
= Tcl_NewListObj (0, NULL
);
2793 sal
= find_pc_line (tp
->address
, 0);
2794 filename
= symtab_to_filename (sal
.symtab
);
2795 if (filename
== NULL
)
2797 Tcl_ListObjAppendElement (interp
, list
,
2798 Tcl_NewStringObj (filename
, -1));
2799 find_pc_partial_function (tp
->address
, &funcname
, NULL
, NULL
);
2800 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewStringObj (funcname
, -1));
2801 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (sal
.line
));
2802 sprintf (tmp
, "0x%lx", tp
->address
);
2803 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewStringObj (tmp
, -1));
2804 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->enabled
));
2805 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->pass_count
));
2806 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->step_count
));
2807 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->thread
));
2808 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->hit_count
));
2810 /* Append a list of actions */
2811 action_list
= Tcl_NewListObj (0, NULL
);
2812 for (al
= tp
->actions
; al
!= NULL
; al
= al
->next
)
2814 Tcl_ListObjAppendElement (interp
, action_list
,
2815 Tcl_NewStringObj (al
->action
, -1));
2817 Tcl_ListObjAppendElement (interp
, list
, action_list
);
2819 Tcl_SetObjResult (interp
, list
);
2824 /* TclDebug (const char *fmt, ...) works just like printf() but */
2825 /* sends the output to the GDB TK debug window. */
2826 /* Not for normal use; just a convenient tool for debugging */
2828 #ifdef ANSI_PROTOTYPES
2829 TclDebug (const char *fmt
, ...)
2836 char buf
[512], *v
[2], *merge
;
2838 #ifdef ANSI_PROTOTYPES
2839 va_start (args
, fmt
);
2843 fmt
= va_arg (args
, char *);
2849 vsprintf (buf
, fmt
, args
);
2852 merge
= Tcl_Merge (2, v
);
2853 Tcl_Eval (interp
, merge
);
2858 /* Find the full pathname to a file, searching the symbol tables */
2861 gdb_find_file_command (clientData
, interp
, objc
, objv
)
2862 ClientData clientData
;
2865 Tcl_Obj
*CONST objv
[];
2867 char *filename
= NULL
;
2872 Tcl_WrongNumArgs(interp
, 1, objv
, "filename");
2876 st
= full_lookup_symtab (Tcl_GetStringFromObj (objv
[1], NULL
));
2878 filename
= st
->fullname
;
2880 if (filename
== NULL
)
2881 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("", 0));
2883 Tcl_SetObjResult (interp
, Tcl_NewStringObj (filename
, -1));
2889 gdbtk_create_tracepoint (tp
)
2890 struct tracepoint
*tp
;
2892 tracepoint_notify (tp
, "create");
2896 gdbtk_delete_tracepoint (tp
)
2897 struct tracepoint
*tp
;
2899 tracepoint_notify (tp
, "delete");
2903 gdbtk_modify_tracepoint (tp
)
2904 struct tracepoint
*tp
;
2906 tracepoint_notify (tp
, "modify");
2910 tracepoint_notify(tp
, action
)
2911 struct tracepoint
*tp
;
2916 struct symtab_and_line sal
;
2919 /* We ensure that ACTION contains no special Tcl characters, so we
2921 sal
= find_pc_line (tp
->address
, 0);
2923 filename
= symtab_to_filename (sal
.symtab
);
2924 if (filename
== NULL
)
2926 sprintf (buf
, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action
, tp
->number
,
2927 (long)tp
->address
, sal
.line
, filename
, tp
->pass_count
);
2929 v
= Tcl_Eval (interp
, buf
);
2933 gdbtk_fputs (interp
->result
, gdb_stdout
);
2934 gdbtk_fputs ("\n", gdb_stdout
);
2938 /* returns -1 if not found, tracepoint # if found */
2940 tracepoint_exists (char * args
)
2942 struct tracepoint
*tp
;
2944 struct symtabs_and_lines sals
;
2948 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2949 if (sals
.nelts
== 1)
2951 resolve_sal_pc (&sals
.sals
[0]);
2952 file
= xmalloc (strlen (sals
.sals
[0].symtab
->dirname
)
2953 + strlen (sals
.sals
[0].symtab
->filename
) + 1);
2956 strcpy (file
, sals
.sals
[0].symtab
->dirname
);
2957 strcat (file
, sals
.sals
[0].symtab
->filename
);
2959 ALL_TRACEPOINTS (tp
)
2961 if (tp
->address
== sals
.sals
[0].pc
)
2962 result
= tp
->number
;
2964 /* Why is this here? This messes up assembly traces */
2965 else if (tp
->source_file
!= NULL
2966 && strcmp (tp
->source_file
, file
) == 0
2967 && sals
.sals
[0].line
== tp
->line_number
)
2968 result
= tp
->number
;
2979 gdb_actions_command (clientData
, interp
, objc
, objv
)
2980 ClientData clientData
;
2983 Tcl_Obj
*CONST objv
[];
2985 struct tracepoint
*tp
;
2987 int nactions
, i
, len
;
2988 char *number
, *args
, *action
;
2990 struct action_line
*next
= NULL
, *temp
;
2994 Tcl_AppendResult (interp
, "wrong # args: should be: \"",
2995 Tcl_GetStringFromObj (objv
[0], NULL
),
2996 " number actions\"");
3000 args
= number
= Tcl_GetStringFromObj (objv
[1], NULL
);
3001 tp
= get_tracepoint_by_number (&args
);
3004 Tcl_AppendResult (interp
, "Tracepoint \"", number
, "\" does not exist");
3008 /* Free any existing actions */
3009 if (tp
->actions
!= NULL
)
3014 Tcl_ListObjGetElements (interp
, objv
[2], &nactions
, &actions
);
3015 for (i
= 0; i
< nactions
; i
++)
3017 temp
= xmalloc (sizeof (struct action_line
));
3019 action
= Tcl_GetStringFromObj (actions
[i
], &len
);
3020 temp
->action
= savestring (action
, len
);
3021 if (sscanf (temp
->action
, "while-stepping %d", &step_count
) !=0)
3022 tp
->step_count
= step_count
;
3039 gdb_tracepoint_exists_command (clientData
, interp
, objc
, objv
)
3040 ClientData clientData
;
3043 Tcl_Obj
*CONST objv
[];
3049 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
3050 Tcl_GetStringFromObj (objv
[0], NULL
),
3051 " function:line|function|line|*addr\"");
3055 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
3057 Tcl_SetObjResult (interp
, Tcl_NewIntObj (tracepoint_exists (args
)));
3061 /* Return the prompt to the interpreter */
3063 gdb_prompt_command (clientData
, interp
, objc
, objv
)
3064 ClientData clientData
;
3067 Tcl_Obj
*CONST objv
[];
3069 Tcl_SetResult (interp
, get_prompt (), TCL_VOLATILE
);
3073 /* return a list of all tracepoint numbers in interpreter */
3075 gdb_get_tracepoint_list (clientData
, interp
, objc
, objv
)
3076 ClientData clientData
;
3079 Tcl_Obj
*CONST objv
[];
3082 struct tracepoint
*tp
;
3084 list
= Tcl_NewListObj (0, NULL
);
3086 ALL_TRACEPOINTS (tp
)
3087 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->number
));
3089 Tcl_SetObjResult (interp
, list
);
3094 /* This hook is called whenever we are ready to load a symbol file so that
3095 the UI can notify the user... */
3097 gdbtk_pre_add_symbol (name
)
3102 v
[0] = "gdbtk_tcl_pre_add_symbol";
3104 merge
= Tcl_Merge (2, v
);
3105 Tcl_Eval (interp
, merge
);
3109 /* This hook is called whenever we finish loading a symbol file. */
3111 gdbtk_post_add_symbol ()
3113 Tcl_Eval (interp
, "gdbtk_tcl_post_add_symbol");
3119 gdbtk_print_frame_info (s
, line
, stopline
, noerror
)
3125 current_source_symtab
= s
;
3126 current_source_line
= line
;
3130 /* The lookup_symtab() in symtab.c doesn't work correctly */
3131 /* It will not work will full pathnames and if multiple */
3132 /* source files have the same basename, it will return */
3133 /* the first one instead of the correct one. This version */
3134 /* also always makes sure symtab->fullname is set. */
3136 static struct symtab
*
3137 full_lookup_symtab(file
)
3141 struct objfile
*objfile
;
3142 char *bfile
, *fullname
;
3143 struct partial_symtab
*pt
;
3148 /* first try a direct lookup */
3149 st
= lookup_symtab (file
);
3153 symtab_to_filename(st
);
3157 /* if the direct approach failed, try */
3158 /* looking up the basename and checking */
3159 /* all matches with the fullname */
3160 bfile
= basename (file
);
3161 ALL_SYMTABS (objfile
, st
)
3163 if (!strcmp (bfile
, basename(st
->filename
)))
3166 fullname
= symtab_to_filename (st
);
3168 fullname
= st
->fullname
;
3170 if (!strcmp (file
, fullname
))
3175 /* still no luck? look at psymtabs */
3176 ALL_PSYMTABS (objfile
, pt
)
3178 if (!strcmp (bfile
, basename(pt
->filename
)))
3180 st
= PSYMTAB_TO_SYMTAB (pt
);
3183 fullname
= symtab_to_filename (st
);
3184 if (!strcmp (file
, fullname
))
3193 perror_with_name_wrapper (args
)
3196 perror_with_name (args
);
3200 /* gdb_loadfile loads a c source file into a text widget. */
3202 /* LTABLE_SIZE is the number of bytes to allocate for the */
3203 /* line table. Its size limits the maximum number of lines */
3204 /* in a file to 8 * LTABLE_SIZE. This memory is freed after */
3205 /* the file is loaded, so it is OK to make this very large. */
3206 /* Additional memory will be allocated if needed. */
3207 #define LTABLE_SIZE 20000
3210 gdb_loadfile (clientData
, interp
, objc
, objv
)
3211 ClientData clientData
;
3214 Tcl_Obj
*CONST objv
[];
3216 char *file
, *widget
, *line
, *buf
, msg
[128];
3217 int linenumbers
, ln
, anum
, lnum
, ltable_size
;
3218 Tcl_Obj
*a
[2], *b
[2], *cmd
;
3221 struct symtab
*symtab
;
3222 struct linetable_entry
*le
;
3229 Tcl_WrongNumArgs(interp
, 1, objv
, "widget filename linenumbers");
3233 widget
= Tcl_GetStringFromObj (objv
[1], NULL
);
3234 file
= Tcl_GetStringFromObj (objv
[2], NULL
);
3235 Tcl_GetBooleanFromObj (interp
, objv
[3], &linenumbers
);
3237 if ((fp
= fopen ( file
, "r" )) == NULL
)
3240 symtab
= full_lookup_symtab (file
);
3243 sprintf(msg
, "File not found");
3244 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3249 if (stat (file
, &st
) < 0)
3251 catch_errors (perror_with_name_wrapper
, "gdbtk: get time stamp", "",
3256 if (symtab
&& symtab
->objfile
&& symtab
->objfile
->obfd
)
3257 mtime
= bfd_get_mtime(symtab
->objfile
->obfd
);
3259 mtime
= bfd_get_mtime(exec_bfd
);
3261 if (mtime
&& mtime
< st
.st_mtime
)
3262 gdbtk_ignorable_warning("Source file is more recent than executable.\n");
3265 /* Source linenumbers don't appear to be in order, and a sort is */
3266 /* too slow so the fastest solution is just to allocate a huge */
3267 /* array and set the array entry for each linenumber */
3269 ltable_size
= LTABLE_SIZE
;
3270 ltable
= (char *)malloc (LTABLE_SIZE
);
3273 sprintf(msg
, "Out of memory.");
3274 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3279 memset (ltable
, 0, LTABLE_SIZE
);
3281 if (symtab
->linetable
&& symtab
->linetable
->nitems
)
3283 le
= symtab
->linetable
->item
;
3284 for (ln
= symtab
->linetable
->nitems
;ln
> 0; ln
--, le
++)
3286 lnum
= le
->line
>> 3;
3287 if (lnum
>= ltable_size
)
3290 new_ltable
= (char *)realloc (ltable
, ltable_size
*2);
3291 memset (new_ltable
+ ltable_size
, 0, ltable_size
);
3293 if (new_ltable
== NULL
)
3295 sprintf(msg
, "Out of memory.");
3296 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3301 ltable
= new_ltable
;
3303 ltable
[lnum
] |= 1 << (le
->line
% 8);
3307 /* create an object with enough space, then grab its */
3308 /* buffer and sprintf directly into it. */
3309 a
[0] = Tcl_NewStringObj (ltable
, 1024);
3310 a
[1] = Tcl_NewListObj(0,NULL
);
3312 b
[0] = Tcl_NewStringObj (ltable
,1024);
3313 b
[1] = Tcl_NewStringObj ("source_tag", -1);
3314 Tcl_IncrRefCount (b
[0]);
3315 Tcl_IncrRefCount (b
[1]);
3316 line
= b
[0]->bytes
+ 1;
3317 strcpy(b
[0]->bytes
,"\t");
3320 while (fgets (line
, 980, fp
))
3324 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
3326 sprintf (buf
,"%s insert end {-\t%d} break_tag", widget
, ln
);
3327 a
[0]->length
= strlen (buf
);
3331 sprintf (buf
,"%s insert end { \t%d} \"\"", widget
, ln
);
3332 a
[0]->length
= strlen (buf
);
3337 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
3339 sprintf (buf
,"%s insert end {-\t} break_tag", widget
);
3340 a
[0]->length
= strlen (buf
);
3344 sprintf (buf
,"%s insert end { \t} \"\"", widget
);
3345 a
[0]->length
= strlen (buf
);
3348 b
[0]->length
= strlen(b
[0]->bytes
);
3349 Tcl_SetListObj(a
[1],2,b
);
3350 cmd
= Tcl_ConcatObj(2,a
);
3351 Tcl_EvalObj (interp
, cmd
);
3352 Tcl_DecrRefCount (cmd
);
3355 Tcl_DecrRefCount (b
[0]);
3356 Tcl_DecrRefCount (b
[0]);
3357 Tcl_DecrRefCount (b
[1]);
3358 Tcl_DecrRefCount (b
[1]);
3364 /* at some point make these static in breakpoint.c and move GUI code there */
3365 extern struct breakpoint
*set_raw_breakpoint (struct symtab_and_line sal
);
3366 extern void set_breakpoint_count (int);
3367 extern int breakpoint_count
;
3369 /* set a breakpoint by source file and line number */
3370 /* flags are as follows: */
3371 /* least significant 2 bits are disposition, rest is */
3372 /* type (normally 0).
3375 bp_breakpoint, Normal breakpoint
3376 bp_hardware_breakpoint, Hardware assisted breakpoint
3379 Disposition of breakpoint. Ie: what to do after hitting it.
3382 del_at_next_stop, Delete at next stop, whether hit or not
3384 donttouch Leave it alone
3389 gdb_set_bp (clientData
, interp
, objc
, objv
)
3390 ClientData clientData
;
3393 Tcl_Obj
*CONST objv
[];
3396 struct symtab_and_line sal
;
3397 int line
, flags
, ret
;
3398 struct breakpoint
*b
;
3400 Tcl_Obj
*a
[5], *cmd
;
3404 Tcl_WrongNumArgs(interp
, 1, objv
, "filename line type");
3408 sal
.symtab
= full_lookup_symtab (Tcl_GetStringFromObj( objv
[1], NULL
));
3409 if (sal
.symtab
== NULL
)
3412 if (Tcl_GetIntFromObj( interp
, objv
[2], &line
) == TCL_ERROR
)
3415 if (Tcl_GetIntFromObj( interp
, objv
[3], &flags
) == TCL_ERROR
)
3419 sal
.pc
= find_line_pc (sal
.symtab
, sal
.line
);
3423 sal
.section
= find_pc_overlay (sal
.pc
);
3424 b
= set_raw_breakpoint (sal
);
3425 set_breakpoint_count (breakpoint_count
+ 1);
3426 b
->number
= breakpoint_count
;
3427 b
->type
= flags
>> 2;
3428 b
->disposition
= flags
& 3;
3430 /* FIXME: this won't work for duplicate basenames! */
3431 sprintf (buf
, "%s:%d", basename(Tcl_GetStringFromObj( objv
[1], NULL
)), line
);
3432 b
->addr_string
= strsave (buf
);
3434 /* now send notification command back to GUI */
3435 sprintf (buf
, "0x%x", sal
.pc
);
3436 a
[0] = Tcl_NewStringObj ("gdbtk_tcl_breakpoint create", -1);
3437 a
[1] = Tcl_NewIntObj (b
->number
);
3438 a
[2] = Tcl_NewStringObj (buf
, -1);
3440 a
[4] = Tcl_NewListObj (1,&objv
[1]);
3441 cmd
= Tcl_ConcatObj(5,a
);
3442 ret
= Tcl_EvalObj (interp
, cmd
);
3443 Tcl_DecrRefCount (cmd
);
3447 /* Come here during initialize_all_files () */
3450 _initialize_gdbtk ()
3454 /* Tell the rest of the world that Gdbtk is now set up. */
3456 init_ui_hook
= gdbtk_init
;
3461 DWORD ft
= GetFileType (GetStdHandle (STD_INPUT_HANDLE
));
3462 void cygwin32_attach_handle_to_fd (char *, int, HANDLE
, int, int);
3466 case FILE_TYPE_DISK
:
3467 case FILE_TYPE_CHAR
:
3468 case FILE_TYPE_PIPE
:
3472 cygwin32_attach_handle_to_fd ("/dev/conin", 0,
3473 GetStdHandle (STD_INPUT_HANDLE
),
3475 cygwin32_attach_handle_to_fd ("/dev/conout", 1,
3476 GetStdHandle (STD_OUTPUT_HANDLE
),
3478 cygwin32_attach_handle_to_fd ("/dev/conout", 2,
3479 GetStdHandle (STD_ERROR_HANDLE
),