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 extern int Tktable_Init
PARAMS ((Tcl_Interp
*interp
));
87 static int No_Update
= 0;
88 static int load_in_progress
= 0;
89 static int in_fputs
= 0;
91 int gdbtk_load_hash
PARAMS ((char *, unsigned long));
92 int (*ui_load_progress_hook
) PARAMS ((char *, unsigned long));
93 void (*pre_add_symbol_hook
) PARAMS ((char *));
94 void (*post_add_symbol_hook
) PARAMS ((void));
97 extern void (*ui_loop_hook
) PARAMS ((int));
100 char * get_prompt
PARAMS ((void));
102 static void null_routine
PARAMS ((int));
103 static void gdbtk_flush
PARAMS ((FILE *));
104 static void gdbtk_fputs
PARAMS ((const char *, FILE *));
105 static int gdbtk_query
PARAMS ((const char *, va_list));
106 static void gdbtk_warning
PARAMS ((const char *, va_list));
107 static void gdbtk_ignorable_warning
PARAMS ((const char *));
108 static char *gdbtk_readline
PARAMS ((char *));
109 static void gdbtk_init
PARAMS ((char *));
110 static void tk_command_loop
PARAMS ((void));
111 static void gdbtk_call_command
PARAMS ((struct cmd_list_element
*, char *, int));
112 static int gdbtk_wait
PARAMS ((int, struct target_waitstatus
*));
113 static void x_event
PARAMS ((int));
114 static void gdbtk_interactive
PARAMS ((void));
115 static void cleanup_init
PARAMS ((int));
116 static void tk_command
PARAMS ((char *, int));
117 static int gdb_disassemble
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
118 static int compare_lines
PARAMS ((const PTR
, const PTR
));
119 static int gdbtk_dis_asm_read_memory
PARAMS ((bfd_vma
, bfd_byte
*, int, disassemble_info
*));
120 static int gdb_path_conv
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
121 static int gdb_stop
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
122 static int gdb_confirm_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
123 static int gdb_force_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
124 static int gdb_listfiles
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
125 static int gdb_listfuncs
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
126 static int call_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
127 static int call_obj_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
128 static int gdb_cmd
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
129 static int gdb_immediate_command
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
130 static int gdb_fetch_registers
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
131 static void gdbtk_readline_end
PARAMS ((void));
132 static void pc_changed
PARAMS ((void));
133 static int gdb_changed_register_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
134 static void register_changed_p
PARAMS ((int, void *));
135 static int gdb_get_breakpoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
136 static int gdb_get_breakpoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
137 static void breakpoint_notify
PARAMS ((struct breakpoint
*, const char *));
138 static void gdbtk_create_breakpoint
PARAMS ((struct breakpoint
*));
139 static void gdbtk_delete_breakpoint
PARAMS ((struct breakpoint
*));
140 static void gdbtk_modify_breakpoint
PARAMS ((struct breakpoint
*));
141 static int gdb_loc
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
142 static int gdb_eval
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
143 static int map_arg_registers
PARAMS ((int, char *[], void (*) (int, void *), void *));
144 static void get_register_name
PARAMS ((int, void *));
145 static int gdb_regnames
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
146 static void get_register
PARAMS ((int, void *));
147 static int gdb_trace_status
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
148 static int gdb_target_has_execution_command
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
149 static int gdb_load_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
150 void TclDebug
PARAMS ((const char *fmt
, ...));
151 static int gdb_get_locals_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
153 static int gdb_get_args_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
155 static int gdb_get_vars_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
156 static int gdb_get_function_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
157 static int gdb_get_line_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
158 static int gdb_get_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
159 static int gdb_tracepoint_exists_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
160 static int gdb_get_tracepoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
161 static int gdb_actions_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
162 static int gdb_prompt_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
163 static int gdb_find_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
164 static int gdb_get_tracepoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
165 static void gdbtk_create_tracepoint
PARAMS ((struct tracepoint
*));
166 static void gdbtk_delete_tracepoint
PARAMS ((struct tracepoint
*));
167 static void gdbtk_modify_tracepoint
PARAMS ((struct tracepoint
*));
168 static void tracepoint_notify
PARAMS ((struct tracepoint
*, const char *));
169 static void gdbtk_print_frame_info
PARAMS ((struct symtab
*, int, int, int));
170 void gdbtk_pre_add_symbol
PARAMS ((char *));
171 void gdbtk_post_add_symbol
PARAMS ((void));
172 static int get_pc_register
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
173 static int gdb_loadfile
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
174 static int gdb_set_bp
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
175 static struct symtab
*full_lookup_symtab
PARAMS ((char *file
));
176 static int gdb_get_mem
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
177 static int gdb_get_trace_frame_num
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
179 /* Handle for TCL interpreter */
180 static Tcl_Interp
*interp
= NULL
;
182 static int gdbtk_timer_going
= 0;
183 static void gdbtk_start_timer
PARAMS ((void));
184 static void gdbtk_stop_timer
PARAMS ((void));
186 /* This variable is true when the inferior is running. Although it's
187 possible to disable most input from widgets and thus prevent
188 attempts to do anything while the inferior is running, any commands
189 that get through - even a simple memory read - are Very Bad, and
190 may cause GDB to crash or behave strangely. So, this variable
191 provides an extra layer of defense. */
193 static int running_now
;
195 /* This variable determines where memory used for disassembly is read from.
196 If > 0, then disassembly comes from the exec file rather than the
197 target (which might be at the other end of a slow serial link). If
198 == 0 then disassembly comes from target. If < 0 disassembly is
199 automatically switched to the target if it's an inferior process,
200 otherwise the exec file is used. */
202 static int disassemble_from_exec
= -1;
206 /* Supply malloc calls for tcl/tk. We do not want to do this on
207 Windows, because Tcl_Alloc is probably in a DLL which will not call
208 the mmalloc routines. */
214 return xmalloc (size
);
218 Tcl_Realloc (ptr
, size
)
222 return xrealloc (ptr
, size
);
232 #endif /* ! _WIN32 */
242 /* On Windows, if we hold a file open, other programs can't write to
243 it. In particular, we don't want to hold the executable open,
244 because it will mean that people have to get out of the debugging
245 session in order to remake their program. So we close it, although
246 this will cost us if and when we need to reopen it. */
256 bfd_cache_close (o
->obfd
);
259 if (exec_bfd
!= NULL
)
260 bfd_cache_close (exec_bfd
);
265 /* The following routines deal with stdout/stderr data, which is created by
266 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
267 lowest level of these routines and capture all output from the rest of GDB.
268 Normally they present their data to tcl via callbacks to the following tcl
269 routines: gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush. These
270 in turn call tk routines to update the display.
272 Under some circumstances, you may want to collect the output so that it can
273 be returned as the value of a tcl procedure. This can be done by
274 surrounding the output routines with calls to start_saving_output and
275 finish_saving_output. The saved data can then be retrieved with
276 get_saved_output (but this must be done before the call to
277 finish_saving_output). */
279 /* Dynamic string for output. */
281 static Tcl_DString
*result_ptr
;
283 /* Dynamic string for stderr. This is only used if result_ptr is
286 static Tcl_DString
*error_string_ptr
;
293 /* Force immediate screen update */
295 Tcl_VarEval (interp
, "gdbtk_tcl_flush", NULL
);
299 /* Print the string PTR, with necessary hair for dealing with the
300 GDB console thingy, etc. To wit:
302 Append the string PTR to result_ptr or error_string_ptr, if they
303 are set. Otherwise, call the Tcl function `gdbtk_tcl_fputs', with
304 the string PTR as its only argument. */
306 gdbtk_fputs (ptr
, stream
)
310 char *merge
[2], *command
;
314 Tcl_DStringAppend (result_ptr
, (char *) ptr
, -1);
315 else if (error_string_ptr
!= NULL
&& stream
== gdb_stderr
)
316 Tcl_DStringAppend (error_string_ptr
, (char *) ptr
, -1);
319 merge
[0] = "gdbtk_tcl_fputs";
320 merge
[1] = (char *)ptr
;
321 command
= Tcl_Merge (2, merge
);
322 Tcl_Eval (interp
, command
);
329 gdbtk_warning (warning
, args
)
333 char buf
[200], *merge
[2];
336 vsprintf (buf
, warning
, args
);
337 merge
[0] = "gdbtk_tcl_warning";
339 command
= Tcl_Merge (2, merge
);
340 Tcl_Eval (interp
, command
);
345 gdbtk_ignorable_warning (warning
)
348 char buf
[200], *merge
[2];
351 sprintf (buf
, warning
);
352 merge
[0] = "gdbtk_tcl_ignorable_warning";
354 command
= Tcl_Merge (2, merge
);
355 Tcl_Eval (interp
, command
);
360 gdbtk_query (query
, args
)
364 char buf
[200], *merge
[2];
368 vsprintf (buf
, query
, args
);
369 merge
[0] = "gdbtk_tcl_query";
371 command
= Tcl_Merge (2, merge
);
372 Tcl_Eval (interp
, command
);
375 val
= atol (interp
->result
);
381 #ifdef ANSI_PROTOTYPES
382 gdbtk_readline_begin (char *format
, ...)
384 gdbtk_readline_begin (va_alist
)
389 char buf
[200], *merge
[2];
392 #ifdef ANSI_PROTOTYPES
393 va_start (args
, format
);
397 format
= va_arg (args
, char *);
400 vsprintf (buf
, format
, args
);
401 merge
[0] = "gdbtk_tcl_readline_begin";
403 command
= Tcl_Merge (2, merge
);
404 Tcl_Eval (interp
, command
);
409 gdbtk_readline (prompt
)
420 merge
[0] = "gdbtk_tcl_readline";
422 command
= Tcl_Merge (2, merge
);
423 result
= Tcl_Eval (interp
, command
);
425 if (result
== TCL_OK
)
427 return (strdup (interp
-> result
));
431 gdbtk_fputs (interp
-> result
, gdb_stdout
);
432 gdbtk_fputs ("\n", gdb_stdout
);
438 gdbtk_readline_end ()
440 Tcl_Eval (interp
, "gdbtk_tcl_readline_end");
446 Tcl_Eval (interp
, "gdbtk_pc_changed");
451 #ifdef ANSI_PROTOTYPES
452 dsprintf_append_element (Tcl_DString
*dsp
, char *format
, ...)
454 dsprintf_append_element (va_alist
)
461 #ifdef ANSI_PROTOTYPES
462 va_start (args
, format
);
468 dsp
= va_arg (args
, Tcl_DString
*);
469 format
= va_arg (args
, char *);
472 vsprintf (buf
, format
, args
);
474 Tcl_DStringAppendElement (dsp
, buf
);
478 gdb_path_conv (clientData
, interp
, argc
, argv
)
479 ClientData clientData
;
485 char pathname
[256], *ptr
;
487 error ("wrong # args");
488 cygwin32_conv_to_full_win32_path (argv
[1], pathname
);
489 for (ptr
= pathname
; *ptr
; ptr
++)
495 char *pathname
= argv
[1];
497 Tcl_DStringAppend (result_ptr
, pathname
, strlen(pathname
));
502 gdb_get_breakpoint_list (clientData
, interp
, argc
, argv
)
503 ClientData clientData
;
508 struct breakpoint
*b
;
509 extern struct breakpoint
*breakpoint_chain
;
512 error ("wrong # args");
514 for (b
= breakpoint_chain
; b
; b
= b
->next
)
515 if (b
->type
== bp_breakpoint
)
516 dsprintf_append_element (result_ptr
, "%d", b
->number
);
522 gdb_get_breakpoint_info (clientData
, interp
, argc
, argv
)
523 ClientData clientData
;
528 struct symtab_and_line sal
;
529 static char *bptypes
[] = {"breakpoint", "hardware breakpoint", "until",
530 "finish", "watchpoint", "hardware watchpoint",
531 "read watchpoint", "access watchpoint",
532 "longjmp", "longjmp resume", "step resume",
533 "through sigtramp", "watchpoint scope",
535 static char *bpdisp
[] = {"delete", "delstop", "disable", "donttouch"};
536 struct command_line
*cmd
;
538 struct breakpoint
*b
;
539 extern struct breakpoint
*breakpoint_chain
;
540 char *funcname
, *fname
, *filename
;
543 error ("wrong # args");
545 bpnum
= atoi (argv
[1]);
547 for (b
= breakpoint_chain
; b
; b
= b
->next
)
548 if (b
->number
== bpnum
)
551 if (!b
|| b
->type
!= bp_breakpoint
)
552 error ("Breakpoint #%d does not exist", bpnum
);
554 sal
= find_pc_line (b
->address
, 0);
556 filename
= symtab_to_filename (sal
.symtab
);
557 if (filename
== NULL
)
559 Tcl_DStringAppendElement (result_ptr
, filename
);
561 find_pc_partial_function (b
->address
, &funcname
, NULL
, NULL
);
562 fname
= cplus_demangle (funcname
, 0);
565 Tcl_DStringAppendElement (result_ptr
, fname
);
569 Tcl_DStringAppendElement (result_ptr
, funcname
);
570 dsprintf_append_element (result_ptr
, "%d", b
->line_number
);
571 dsprintf_append_element (result_ptr
, "0x%lx", b
->address
);
572 Tcl_DStringAppendElement (result_ptr
, bptypes
[b
->type
]);
573 Tcl_DStringAppendElement (result_ptr
, b
->enable
== enabled
? "1" : "0");
574 Tcl_DStringAppendElement (result_ptr
, bpdisp
[b
->disposition
]);
575 dsprintf_append_element (result_ptr
, "%d", b
->ignore_count
);
577 Tcl_DStringStartSublist (result_ptr
);
578 for (cmd
= b
->commands
; cmd
; cmd
= cmd
->next
)
579 Tcl_DStringAppendElement (result_ptr
, cmd
->line
);
580 Tcl_DStringEndSublist (result_ptr
);
582 Tcl_DStringAppendElement (result_ptr
, b
->cond_string
);
584 dsprintf_append_element (result_ptr
, "%d", b
->thread
);
585 dsprintf_append_element (result_ptr
, "%d", b
->hit_count
);
591 breakpoint_notify(b
, action
)
592 struct breakpoint
*b
;
597 struct symtab_and_line sal
;
600 if (b
->type
!= bp_breakpoint
)
603 /* We ensure that ACTION contains no special Tcl characters, so we
605 sal
= find_pc_line (b
->address
, 0);
606 filename
= symtab_to_filename (sal
.symtab
);
607 if (filename
== NULL
)
610 sprintf (buf
, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action
, b
->number
,
611 (long)b
->address
, b
->line_number
, filename
);
613 v
= Tcl_Eval (interp
, buf
);
617 gdbtk_fputs (interp
->result
, gdb_stdout
);
618 gdbtk_fputs ("\n", gdb_stdout
);
623 gdbtk_create_breakpoint(b
)
624 struct breakpoint
*b
;
626 breakpoint_notify (b
, "create");
630 gdbtk_delete_breakpoint(b
)
631 struct breakpoint
*b
;
633 breakpoint_notify (b
, "delete");
637 gdbtk_modify_breakpoint(b
)
638 struct breakpoint
*b
;
640 breakpoint_notify (b
, "modify");
643 /* This implements the TCL command `gdb_loc', which returns a list */
644 /* consisting of the following: */
645 /* basename, function name, filename, line number, address, current pc */
648 gdb_loc (clientData
, interp
, argc
, argv
)
649 ClientData clientData
;
655 struct symtab_and_line sal
;
656 char *funcname
, *fname
;
659 if (!have_full_symbols () && !have_partial_symbols ())
661 Tcl_SetResult (interp
, "No symbol table is loaded", TCL_STATIC
);
667 if (selected_frame
&& (selected_frame
->pc
!= stop_pc
))
669 /* Note - this next line is not correct on all architectures. */
670 /* For a graphical debugged we really want to highlight the */
671 /* assembly line that called the next function on the stack. */
672 /* Many architectures have the next instruction saved as the */
673 /* pc on the stack, so what happens is the next instruction is hughlighted. */
675 pc
= selected_frame
->pc
;
676 sal
= find_pc_line (selected_frame
->pc
,
677 selected_frame
->next
!= NULL
678 && !selected_frame
->next
->signal_handler_caller
679 && !frame_in_dummy (selected_frame
->next
));
684 sal
= find_pc_line (stop_pc
, 0);
689 struct symtabs_and_lines sals
;
692 sals
= decode_line_spec (argv
[1], 1);
699 error ("Ambiguous line spec");
704 error ("wrong # args");
707 Tcl_DStringAppendElement (result_ptr
, sal
.symtab
->filename
);
709 Tcl_DStringAppendElement (result_ptr
, "");
711 find_pc_partial_function (pc
, &funcname
, NULL
, NULL
);
712 fname
= cplus_demangle (funcname
, 0);
715 Tcl_DStringAppendElement (result_ptr
, fname
);
719 Tcl_DStringAppendElement (result_ptr
, funcname
);
720 filename
= symtab_to_filename (sal
.symtab
);
721 if (filename
== NULL
)
724 Tcl_DStringAppendElement (result_ptr
, filename
);
725 dsprintf_append_element (result_ptr
, "%d", sal
.line
); /* line number */
726 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(pc
)); /* PC in current frame */
727 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(stop_pc
)); /* Real PC */
731 /* This implements the TCL command `gdb_eval'. */
734 gdb_eval (clientData
, interp
, argc
, argv
)
735 ClientData clientData
;
740 struct expression
*expr
;
741 struct cleanup
*old_chain
;
745 error ("wrong # args");
747 expr
= parse_expression (argv
[1]);
749 old_chain
= make_cleanup (free_current_contents
, &expr
);
751 val
= evaluate_expression (expr
);
753 val_print (VALUE_TYPE (val
), VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
754 gdb_stdout
, 0, 0, 0, 0);
756 do_cleanups (old_chain
);
761 /* gdb_get_mem addr form size num aschar*/
762 /* dump a block of memory */
763 /* addr: address of data to dump */
764 /* form: a char indicating format */
765 /* size: size of each element; 1,2,4, or 8 bytes*/
766 /* num: the number of bytes to read */
767 /* acshar: an optional ascii character to use in ASCII dump */
768 /* returns a list of elements followed by an optional */
772 gdb_get_mem (clientData
, interp
, argc
, argv
)
773 ClientData clientData
;
778 int size
, asize
, i
, j
, bc
;
780 int nbytes
, rnum
, bpr
;
781 char format
, c
, *ptr
, buff
[128], aschar
, *mbuf
, *mptr
, *cptr
, *bptr
;
782 struct type
*val_type
;
784 if (argc
< 6 || argc
> 7)
786 interp
->result
= "addr format size bytes bytes_per_row ?ascii_char?";
790 size
= (int)strtoul(argv
[3],(char **)NULL
,0);
791 nbytes
= (int)strtoul(argv
[4],(char **)NULL
,0);
792 bpr
= (int)strtoul(argv
[5],(char **)NULL
,0);
793 if (nbytes
<= 0 || bpr
<= 0 || size
<= 0)
795 interp
->result
= "Invalid number of bytes.";
799 addr
= (CORE_ADDR
)strtoul(argv
[1],(char **)NULL
,0);
801 mbuf
= (char *)malloc (nbytes
+32);
804 interp
->result
= "Out of memory.";
807 memset (mbuf
, 0, nbytes
+32);
810 rnum
= target_read_memory_partial (addr
, mbuf
, nbytes
, NULL
);
819 val_type
= builtin_type_char
;
823 val_type
= builtin_type_short
;
827 val_type
= builtin_type_int
;
831 val_type
= builtin_type_long_long
;
835 val_type
= builtin_type_char
;
839 bc
= 0; /* count of bytes in a row */
840 buff
[0] = '"'; /* buffer for ascii dump */
841 bptr
= &buff
[1]; /* pointer for ascii dump */
843 for (i
=0; i
< nbytes
; i
+= size
)
847 fputs_unfiltered ("N/A ", gdb_stdout
);
849 for ( j
= 0; j
< size
; j
++)
854 print_scalar_formatted (mptr
, val_type
, format
, asize
, gdb_stdout
);
855 fputs_unfiltered (" ", gdb_stdout
);
858 for ( j
= 0; j
< size
; j
++)
861 if (c
< 32 || c
> 126)
873 if (aschar
&& (bc
>= bpr
))
875 /* end of row. print it and reset variables */
880 fputs_unfiltered (buff
, gdb_stdout
);
890 map_arg_registers (argc
, argv
, func
, argp
)
893 void (*func
) PARAMS ((int regnum
, void *argp
));
898 /* Note that the test for a valid register must include checking the
899 reg_names array because NUM_REGS may be allocated for the union of the
900 register sets within a family of related processors. In this case, the
901 trailing entries of reg_names will change depending upon the particular
902 processor being debugged. */
904 if (argc
== 0) /* No args, just do all the regs */
908 && reg_names
[regnum
] != NULL
909 && *reg_names
[regnum
] != '\000';
916 /* Else, list of register #s, just do listed regs */
917 for (; argc
> 0; argc
--, argv
++)
919 regnum
= atoi (*argv
);
923 && reg_names
[regnum
] != NULL
924 && *reg_names
[regnum
] != '\000')
927 error ("bad register number");
934 get_register_name (regnum
, argp
)
936 void *argp
; /* Ignored */
938 Tcl_DStringAppendElement (result_ptr
, reg_names
[regnum
]);
941 /* This implements the TCL command `gdb_regnames', which returns a list of
942 all of the register names. */
945 gdb_regnames (clientData
, interp
, argc
, argv
)
946 ClientData clientData
;
954 return map_arg_registers (argc
, argv
, get_register_name
, NULL
);
957 #ifndef REGISTER_CONVERTIBLE
958 #define REGISTER_CONVERTIBLE(x) (0 != 0)
961 #ifndef REGISTER_CONVERT_TO_VIRTUAL
962 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
965 #ifndef INVALID_FLOAT
966 #define INVALID_FLOAT(x, y) (0 != 0)
970 get_register (regnum
, fp
)
974 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
975 char virtual_buffer
[MAX_REGISTER_VIRTUAL_SIZE
];
976 int format
= (int)fp
;
981 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
983 Tcl_DStringAppendElement (result_ptr
, "Optimized out");
987 /* Convert raw data to virtual format if necessary. */
989 if (REGISTER_CONVERTIBLE (regnum
))
991 REGISTER_CONVERT_TO_VIRTUAL (regnum
, REGISTER_VIRTUAL_TYPE (regnum
),
992 raw_buffer
, virtual_buffer
);
995 memcpy (virtual_buffer
, raw_buffer
, REGISTER_VIRTUAL_SIZE (regnum
));
1000 printf_filtered ("0x");
1001 for (j
= 0; j
< REGISTER_RAW_SIZE (regnum
); j
++)
1003 register int idx
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? j
1004 : REGISTER_RAW_SIZE (regnum
) - 1 - j
;
1005 printf_filtered ("%02x", (unsigned char)raw_buffer
[idx
]);
1009 val_print (REGISTER_VIRTUAL_TYPE (regnum
), virtual_buffer
, 0,
1010 gdb_stdout
, format
, 1, 0, Val_pretty_default
);
1012 Tcl_DStringAppend (result_ptr
, " ", -1);
1016 get_pc_register (clientData
, interp
, argc
, argv
)
1017 ClientData clientData
;
1022 sprintf(interp
->result
,"0x%llx",(long long)read_register(PC_REGNUM
));
1027 gdb_fetch_registers (clientData
, interp
, argc
, argv
)
1028 ClientData clientData
;
1036 error ("wrong # args");
1042 return map_arg_registers (argc
, argv
, get_register
, (void *) format
);
1045 /* This contains the previous values of the registers, since the last call to
1046 gdb_changed_register_list. */
1048 static char old_regs
[REGISTER_BYTES
];
1051 register_changed_p (regnum
, argp
)
1053 void *argp
; /* Ignored */
1055 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
1057 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
1060 if (memcmp (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1061 REGISTER_RAW_SIZE (regnum
)) == 0)
1064 /* Found a changed register. Save new value and return its number. */
1066 memcpy (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1067 REGISTER_RAW_SIZE (regnum
));
1069 dsprintf_append_element (result_ptr
, "%d", regnum
);
1073 gdb_changed_register_list (clientData
, interp
, argc
, argv
)
1074 ClientData clientData
;
1082 return map_arg_registers (argc
, argv
, register_changed_p
, NULL
);
1085 /* This implements the tcl command "gdb_immediate", which does exactly
1086 the same thing as gdb_cmd, except NONE of its outut is buffered. */
1087 /* This will also ALWAYS cause the busy,update, and idle hooks to be
1088 called, contrasted with gdb_cmd, which NEVER calls them. */
1090 gdb_immediate_command (clientData
, interp
, argc
, argv
)
1091 ClientData clientData
;
1096 Tcl_DString
*save_ptr
= NULL
;
1099 error ("wrong # args");
1101 if (running_now
|| load_in_progress
)
1106 Tcl_DStringAppend (result_ptr
, "", -1);
1107 save_ptr
= result_ptr
;
1110 execute_command (argv
[1], 1);
1112 bpstat_do_actions (&stop_bpstat
);
1114 result_ptr
= save_ptr
;
1119 /* This implements the TCL command `gdb_cmd', which sends its argument into
1120 the GDB command scanner. */
1121 /* This command will never cause the update, idle and busy hooks to be called
1124 gdb_cmd (clientData
, interp
, argc
, argv
)
1125 ClientData clientData
;
1130 Tcl_DString
*save_ptr
= NULL
;
1133 error ("wrong # args");
1135 if (running_now
|| load_in_progress
)
1140 /* for the load instruction (and possibly others later) we
1141 set result_ptr to NULL so gdbtk_fputs() will not buffer
1142 all the data until the command is finished. */
1144 if (strncmp ("load ", argv
[1], 5) == 0
1145 || strncmp ("while ", argv
[1], 6) == 0)
1147 Tcl_DStringAppend (result_ptr
, "", -1);
1148 save_ptr
= result_ptr
;
1150 load_in_progress
= 1;
1151 gdbtk_start_timer ();
1154 execute_command (argv
[1], 1);
1156 if (load_in_progress
)
1158 gdbtk_stop_timer ();
1159 load_in_progress
= 0;
1162 bpstat_do_actions (&stop_bpstat
);
1165 result_ptr
= save_ptr
;
1170 /* Client of call_wrapper - this routine performs the actual call to
1171 the client function. */
1173 struct wrapped_call_args
1184 struct wrapped_call_args
*args
;
1186 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->argc
, args
->argv
);
1190 struct wrapped_call_objs
1193 Tcl_ObjCmdProc
*func
;
1195 Tcl_Obj
* CONST
*objv
;
1200 wrapped_obj_call (args
)
1201 struct wrapped_call_objs
*args
;
1203 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->objc
, args
->objv
);
1207 /* This routine acts as a top-level for all GDB code called by tcl/Tk. It
1208 handles cleanups, and calls to return_to_top_level (usually via error).
1209 This is necessary in order to prevent a longjmp out of the bowels of Tk,
1210 possibly leaving things in a bad state. Since this routine can be called
1211 recursively, it needs to save and restore the contents of the jmp_buf as
1215 call_wrapper (clientData
, interp
, argc
, argv
)
1216 ClientData clientData
;
1221 struct wrapped_call_args wrapped_args
;
1222 Tcl_DString result
, *old_result_ptr
;
1223 Tcl_DString error_string
, *old_error_string_ptr
;
1225 Tcl_DStringInit (&result
);
1226 old_result_ptr
= result_ptr
;
1227 result_ptr
= &result
;
1229 Tcl_DStringInit (&error_string
);
1230 old_error_string_ptr
= error_string_ptr
;
1231 error_string_ptr
= &error_string
;
1233 wrapped_args
.func
= (Tcl_CmdProc
*)clientData
;
1234 wrapped_args
.interp
= interp
;
1235 wrapped_args
.argc
= argc
;
1236 wrapped_args
.argv
= argv
;
1237 wrapped_args
.val
= 0;
1239 if (!catch_errors (wrapped_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
1241 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
1243 /* Make sure the timer interrupts are turned off. */
1244 if (gdbtk_timer_going
)
1245 gdbtk_stop_timer ();
1247 gdb_flush (gdb_stderr
); /* Flush error output */
1248 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
1250 /* In case of an error, we may need to force the GUI into idle
1251 mode because gdbtk_call_command may have bombed out while in
1252 the command routine. */
1255 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1258 /* do not suppress any errors -- a remote target could have errored */
1259 load_in_progress
= 0;
1261 if (Tcl_DStringLength (&error_string
) == 0)
1263 Tcl_DStringResult (interp
, &result
);
1264 Tcl_DStringFree (&error_string
);
1266 else if (Tcl_DStringLength (&result
) == 0)
1268 Tcl_DStringResult (interp
, &error_string
);
1269 Tcl_DStringFree (&result
);
1270 Tcl_DStringFree (&error_string
);
1274 Tcl_ResetResult (interp
);
1275 Tcl_AppendResult (interp
, Tcl_DStringValue (&result
),
1276 Tcl_DStringValue (&error_string
), (char *) NULL
);
1277 Tcl_DStringFree (&result
);
1278 Tcl_DStringFree (&error_string
);
1281 result_ptr
= old_result_ptr
;
1282 error_string_ptr
= old_error_string_ptr
;
1288 return wrapped_args
.val
;
1291 call_obj_wrapper (clientData
, interp
, objc
, objv
)
1292 ClientData clientData
;
1295 Tcl_Obj
*CONST objv
[];
1297 struct wrapped_call_objs wrapped_args
;
1298 Tcl_DString result
, *old_result_ptr
;
1299 Tcl_DString error_string
, *old_error_string_ptr
;
1301 /* The obj call wrapper works differently from the string wrapper, because
1302 * the obj calls currently insert their results directly into the
1303 * interpreter's result. So there is no need to have a result_ptr...
1304 * FIXME - rewrite all the object commands so they use a result_obj_ptr
1305 * - rewrite all the string commands to be object commands.
1308 Tcl_DStringInit (&result
);
1309 old_result_ptr
= result_ptr
;
1310 result_ptr
= &result
;
1312 Tcl_DStringInit (&error_string
);
1314 Tcl_DStringInit (&error_string
);
1315 old_error_string_ptr
= error_string_ptr
;
1316 error_string_ptr
= &error_string
;
1318 wrapped_args
.func
= (Tcl_ObjCmdProc
*)clientData
;
1319 wrapped_args
.interp
= interp
;
1320 wrapped_args
.objc
= objc
;
1321 wrapped_args
.objv
= objv
;
1322 wrapped_args
.val
= 0;
1324 if (!catch_errors (wrapped_obj_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
1326 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
1328 /* Make sure the timer interrupts are turned off. */
1329 if (gdbtk_timer_going
)
1330 gdbtk_stop_timer ();
1332 gdb_flush (gdb_stderr
); /* Flush error output */
1333 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
1335 /* In case of an error, we may need to force the GUI into idle
1336 mode because gdbtk_call_command may have bombed out while in
1337 the command routine. */
1340 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1341 /* if the error message is in RESULT instead of ERROR_STRING we copy it
1342 back to ERROR_STRING and free RESULT */
1344 if ((Tcl_DStringLength (&error_string
) == 0) &&
1345 (Tcl_DStringLength (&result
) > 0))
1347 Tcl_DStringAppend (&error_string
, Tcl_DStringValue (&result
),
1348 Tcl_DStringLength (&result
));
1349 Tcl_DStringFree (&result
);
1353 /* do not suppress any errors -- a remote target could have errored */
1354 load_in_progress
= 0;
1356 if (Tcl_DStringLength (&error_string
) == 0)
1358 /* We should insert the result here, but the obj commands now
1359 * do this directly, so we don't need to.
1360 * FIXME - ultimately, all this should be redone so that all the
1361 * commands either manipulate the Tcl result directly, or use a result_ptr.
1364 Tcl_DStringFree (&error_string
);
1366 else if (*(Tcl_GetStringResult (interp
)) == '\0')
1368 Tcl_DStringResult (interp
, &error_string
);
1369 Tcl_DStringFree (&error_string
);
1373 Tcl_AppendToObj(Tcl_GetObjResult(interp
), Tcl_DStringValue (&error_string
),
1374 Tcl_DStringLength (&error_string
));
1375 Tcl_DStringFree (&error_string
);
1378 result_ptr
= old_result_ptr
;
1379 error_string_ptr
= old_error_string_ptr
;
1385 return wrapped_args
.val
;
1389 comp_files (file1
, file2
)
1390 const char *file1
[], *file2
[];
1392 return strcmp(*file1
,*file2
);
1396 gdb_listfiles (clientData
, interp
, objc
, objv
)
1397 ClientData clientData
;
1400 Tcl_Obj
*CONST objv
[];
1402 struct objfile
*objfile
;
1403 struct partial_symtab
*psymtab
;
1404 struct symtab
*symtab
;
1405 char *lastfile
, *pathname
, **files
;
1407 int i
, numfiles
= 0, len
= 0;
1411 files
= (char **) xmalloc (sizeof (char *) * files_size
);
1415 Tcl_WrongNumArgs (interp
, 1, objv
, "Usage: gdb_listfiles ?pathname?");
1419 pathname
= Tcl_GetStringFromObj (objv
[1], &len
);
1421 mylist
= Tcl_NewListObj (0, NULL
);
1423 ALL_PSYMTABS (objfile
, psymtab
)
1425 if (numfiles
== files_size
)
1427 files_size
= files_size
* 2;
1428 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1432 if (psymtab
->filename
)
1433 files
[numfiles
++] = basename(psymtab
->filename
);
1435 else if (!strcmp(psymtab
->filename
,basename(psymtab
->filename
))
1436 || !strncmp(pathname
,psymtab
->filename
,len
))
1437 if (psymtab
->filename
)
1438 files
[numfiles
++] = basename(psymtab
->filename
);
1441 ALL_SYMTABS (objfile
, symtab
)
1443 if (numfiles
== files_size
)
1445 files_size
= files_size
* 2;
1446 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1450 if (symtab
->filename
)
1451 files
[numfiles
++] = basename(symtab
->filename
);
1453 else if (!strcmp(symtab
->filename
,basename(symtab
->filename
))
1454 || !strncmp(pathname
,symtab
->filename
,len
))
1455 if (symtab
->filename
)
1456 files
[numfiles
++] = basename(symtab
->filename
);
1459 qsort (files
, numfiles
, sizeof(char *), comp_files
);
1462 for (i
= 0; i
< numfiles
; i
++)
1464 if (strcmp(files
[i
],lastfile
))
1465 Tcl_ListObjAppendElement (interp
, mylist
, Tcl_NewStringObj(files
[i
], -1));
1466 lastfile
= files
[i
];
1468 Tcl_SetObjResult (interp
, mylist
);
1474 gdb_listfuncs (clientData
, interp
, argc
, argv
)
1475 ClientData clientData
;
1480 struct symtab
*symtab
;
1481 struct blockvector
*bv
;
1488 error ("wrong # args");
1490 symtab
= full_lookup_symtab (argv
[1]);
1492 error ("No such file");
1494 bv
= BLOCKVECTOR (symtab
);
1495 for (i
= GLOBAL_BLOCK
; i
<= STATIC_BLOCK
; i
++)
1497 b
= BLOCKVECTOR_BLOCK (bv
, i
);
1498 /* Skip the sort if this block is always sorted. */
1499 if (!BLOCK_SHOULD_SORT (b
))
1500 sort_block_syms (b
);
1501 for (j
= 0; j
< BLOCK_NSYMS (b
); j
++)
1503 sym
= BLOCK_SYM (b
, j
);
1504 if (SYMBOL_CLASS (sym
) == LOC_BLOCK
)
1507 char *name
= cplus_demangle (SYMBOL_NAME(sym
), 0);
1510 sprintf (buf
,"{%s} 1", name
);
1513 sprintf (buf
,"{%s} 0", SYMBOL_NAME(sym
));
1514 Tcl_DStringAppendElement (result_ptr
, buf
);
1522 target_stop_wrapper (args
)
1530 gdb_stop (clientData
, interp
, argc
, argv
)
1531 ClientData clientData
;
1538 catch_errors (target_stop_wrapper
, NULL
, "",
1542 quit_flag
= 1; /* hope something sees this */
1547 /* Prepare to accept a new executable file. This is called when we
1548 want to clear away everything we know about the old file, without
1549 asking the user. The Tcl code will have already asked the user if
1550 necessary. After this is called, we should be able to run the
1551 `file' command without getting any questions. */
1554 gdb_clear_file (clientData
, interp
, argc
, argv
)
1555 ClientData clientData
;
1560 if (inferior_pid
!= 0 && target_has_execution
)
1563 target_detach (NULL
, 0);
1568 if (target_has_execution
)
1571 symbol_file_command (NULL
, 0);
1573 /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
1574 clear it here. FIXME: This seems like an abstraction violation
1581 /* Ask the user to confirm an exit request. */
1584 gdb_confirm_quit (clientData
, interp
, argc
, argv
)
1585 ClientData clientData
;
1592 ret
= quit_confirm ();
1593 Tcl_DStringAppendElement (result_ptr
, ret
? "1" : "0");
1597 /* Quit without asking for confirmation. */
1600 gdb_force_quit (clientData
, interp
, argc
, argv
)
1601 ClientData clientData
;
1606 quit_force ((char *) NULL
, 1);
1610 /* This implements the TCL command `gdb_disassemble'. */
1613 gdbtk_dis_asm_read_memory (memaddr
, myaddr
, len
, info
)
1617 disassemble_info
*info
;
1619 extern struct target_ops exec_ops
;
1623 res
= xfer_memory (memaddr
, myaddr
, len
, 0, &exec_ops
);
1634 /* We need a different sort of line table from the normal one cuz we can't
1635 depend upon implicit line-end pc's for lines. This is because of the
1636 reordering we are about to do. */
1638 struct my_line_entry
{
1645 compare_lines (mle1p
, mle2p
)
1649 struct my_line_entry
*mle1
, *mle2
;
1652 mle1
= (struct my_line_entry
*) mle1p
;
1653 mle2
= (struct my_line_entry
*) mle2p
;
1655 val
= mle1
->line
- mle2
->line
;
1660 return mle1
->start_pc
- mle2
->start_pc
;
1664 gdb_disassemble (clientData
, interp
, argc
, argv
)
1665 ClientData clientData
;
1670 CORE_ADDR pc
, low
, high
;
1671 int mixed_source_and_assembly
;
1672 static disassemble_info di
;
1673 static int di_initialized
;
1675 if (! di_initialized
)
1677 INIT_DISASSEMBLE_INFO_NO_ARCH (di
, gdb_stdout
,
1678 (fprintf_ftype
) fprintf_unfiltered
);
1679 di
.flavour
= bfd_target_unknown_flavour
;
1680 di
.memory_error_func
= dis_asm_memory_error
;
1681 di
.print_address_func
= dis_asm_print_address
;
1685 di
.mach
= tm_print_insn_info
.mach
;
1686 if (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1687 di
.endian
= BFD_ENDIAN_BIG
;
1689 di
.endian
= BFD_ENDIAN_LITTLE
;
1691 if (argc
!= 3 && argc
!= 4)
1692 error ("wrong # args");
1694 if (strcmp (argv
[1], "source") == 0)
1695 mixed_source_and_assembly
= 1;
1696 else if (strcmp (argv
[1], "nosource") == 0)
1697 mixed_source_and_assembly
= 0;
1699 error ("First arg must be 'source' or 'nosource'");
1701 low
= parse_and_eval_address (argv
[2]);
1705 if (find_pc_partial_function (low
, NULL
, &low
, &high
) == 0)
1706 error ("No function contains specified address");
1709 high
= parse_and_eval_address (argv
[3]);
1711 /* If disassemble_from_exec == -1, then we use the following heuristic to
1712 determine whether or not to do disassembly from target memory or from the
1715 If we're debugging a local process, read target memory, instead of the
1716 exec file. This makes disassembly of functions in shared libs work
1719 Else, we're debugging a remote process, and should disassemble from the
1720 exec file for speed. However, this is no good if the target modifies its
1721 code (for relocation, or whatever).
1724 if (disassemble_from_exec
== -1)
1725 if (strcmp (target_shortname
, "child") == 0
1726 || strcmp (target_shortname
, "procfs") == 0
1727 || strcmp (target_shortname
, "vxprocess") == 0)
1728 disassemble_from_exec
= 0; /* It's a child process, read inferior mem */
1730 disassemble_from_exec
= 1; /* It's remote, read the exec file */
1732 if (disassemble_from_exec
)
1733 di
.read_memory_func
= gdbtk_dis_asm_read_memory
;
1735 di
.read_memory_func
= dis_asm_read_memory
;
1737 /* If just doing straight assembly, all we need to do is disassemble
1738 everything between low and high. If doing mixed source/assembly, we've
1739 got a totally different path to follow. */
1741 if (mixed_source_and_assembly
)
1742 { /* Come here for mixed source/assembly */
1743 /* The idea here is to present a source-O-centric view of a function to
1744 the user. This means that things are presented in source order, with
1745 (possibly) out of order assembly immediately following. */
1746 struct symtab
*symtab
;
1747 struct linetable_entry
*le
;
1750 struct my_line_entry
*mle
;
1751 struct symtab_and_line sal
;
1756 symtab
= find_pc_symtab (low
); /* Assume symtab is valid for whole PC range */
1761 /* First, convert the linetable to a bunch of my_line_entry's. */
1763 le
= symtab
->linetable
->item
;
1764 nlines
= symtab
->linetable
->nitems
;
1769 mle
= (struct my_line_entry
*) alloca (nlines
* sizeof (struct my_line_entry
));
1773 /* Copy linetable entries for this function into our data structure, creating
1774 end_pc's and setting out_of_order as appropriate. */
1776 /* First, skip all the preceding functions. */
1778 for (i
= 0; i
< nlines
- 1 && le
[i
].pc
< low
; i
++) ;
1780 /* Now, copy all entries before the end of this function. */
1783 for (; i
< nlines
- 1 && le
[i
].pc
< high
; i
++)
1785 if (le
[i
].line
== le
[i
+ 1].line
1786 && le
[i
].pc
== le
[i
+ 1].pc
)
1787 continue; /* Ignore duplicates */
1789 mle
[newlines
].line
= le
[i
].line
;
1790 if (le
[i
].line
> le
[i
+ 1].line
)
1792 mle
[newlines
].start_pc
= le
[i
].pc
;
1793 mle
[newlines
].end_pc
= le
[i
+ 1].pc
;
1797 /* If we're on the last line, and it's part of the function, then we need to
1798 get the end pc in a special way. */
1803 mle
[newlines
].line
= le
[i
].line
;
1804 mle
[newlines
].start_pc
= le
[i
].pc
;
1805 sal
= find_pc_line (le
[i
].pc
, 0);
1806 mle
[newlines
].end_pc
= sal
.end
;
1810 /* Now, sort mle by line #s (and, then by addresses within lines). */
1813 qsort (mle
, newlines
, sizeof (struct my_line_entry
), compare_lines
);
1815 /* Now, for each line entry, emit the specified lines (unless they have been
1816 emitted before), followed by the assembly code for that line. */
1818 next_line
= 0; /* Force out first line */
1819 for (i
= 0; i
< newlines
; i
++)
1821 /* Print out everything from next_line to the current line. */
1823 if (mle
[i
].line
>= next_line
)
1826 print_source_lines (symtab
, next_line
, mle
[i
].line
+ 1, 0);
1828 print_source_lines (symtab
, mle
[i
].line
, mle
[i
].line
+ 1, 0);
1830 next_line
= mle
[i
].line
+ 1;
1833 for (pc
= mle
[i
].start_pc
; pc
< mle
[i
].end_pc
; )
1836 fputs_unfiltered (" ", gdb_stdout
);
1837 print_address (pc
, gdb_stdout
);
1838 fputs_unfiltered (":\t ", gdb_stdout
);
1839 pc
+= (*tm_print_insn
) (pc
, &di
);
1840 fputs_unfiltered ("\n", gdb_stdout
);
1847 for (pc
= low
; pc
< high
; )
1850 fputs_unfiltered (" ", gdb_stdout
);
1851 print_address (pc
, gdb_stdout
);
1852 fputs_unfiltered (":\t ", gdb_stdout
);
1853 pc
+= (*tm_print_insn
) (pc
, &di
);
1854 fputs_unfiltered ("\n", gdb_stdout
);
1858 gdb_flush (gdb_stdout
);
1864 tk_command (cmd
, from_tty
)
1870 struct cleanup
*old_chain
;
1872 /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1874 error_no_arg ("tcl command to interpret");
1876 retval
= Tcl_Eval (interp
, cmd
);
1878 result
= strdup (interp
->result
);
1880 old_chain
= make_cleanup (free
, result
);
1882 if (retval
!= TCL_OK
)
1885 printf_unfiltered ("%s\n", result
);
1887 do_cleanups (old_chain
);
1891 cleanup_init (ignored
)
1895 Tcl_DeleteInterp (interp
);
1899 /* Come here during long calculations to check for GUI events. Usually invoked
1900 via the QUIT macro. */
1903 gdbtk_interactive ()
1905 /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1908 /* Come here when there is activity on the X file descriptor. */
1914 static int in_x_event
= 0;
1915 static Tcl_Obj
*varname
= NULL
;
1916 if (in_x_event
|| in_fputs
)
1923 if (gdbtk_timer_going
)
1924 gdbtk_stop_timer ();
1927 /* Process pending events */
1928 while (Tcl_DoOneEvent (TCL_DONT_WAIT
|TCL_ALL_EVENTS
) != 0)
1931 if (load_in_progress
)
1934 if (varname
== NULL
)
1936 Tcl_Obj
*varnamestrobj
= Tcl_NewStringObj("download_cancel_ok",-1);
1937 varname
= Tcl_ObjGetVar2(interp
,varnamestrobj
,NULL
,TCL_GLOBAL_ONLY
);
1939 if ((Tcl_GetIntFromObj(interp
,varname
,&val
) == TCL_OK
) && val
)
1953 /* For Cygwin32, we use a timer to periodically check for Windows
1954 messages. FIXME: It would be better to not poll, but to instead
1955 rewrite the target_wait routines to serve as input sources.
1956 Unfortunately, that will be a lot of work. */
1957 static sigset_t nullsigmask
;
1958 static struct sigaction act1
, act2
;
1959 static struct itimerval it_on
, it_off
;
1962 gdbtk_start_timer ()
1964 static int first
= 1;
1965 /*TclDebug ("Starting timer....");*/
1968 /* first time called, set up all the structs */
1970 sigemptyset (&nullsigmask
);
1972 act1
.sa_handler
= x_event
;
1973 act1
.sa_mask
= nullsigmask
;
1976 act2
.sa_handler
= SIG_IGN
;
1977 act2
.sa_mask
= nullsigmask
;
1980 it_on
.it_interval
.tv_sec
= 0;
1981 it_on
.it_interval
.tv_usec
= 250000; /* .25 sec */
1982 it_on
.it_value
.tv_sec
= 0;
1983 it_on
.it_value
.tv_usec
= 250000;
1985 it_off
.it_interval
.tv_sec
= 0;
1986 it_off
.it_interval
.tv_usec
= 0;
1987 it_off
.it_value
.tv_sec
= 0;
1988 it_off
.it_value
.tv_usec
= 0;
1991 if (!gdbtk_timer_going
)
1993 sigaction (SIGALRM
, &act1
, NULL
);
1994 setitimer (ITIMER_REAL
, &it_on
, NULL
);
1995 gdbtk_timer_going
= 1;
2002 if (gdbtk_timer_going
)
2004 gdbtk_timer_going
= 0;
2005 /*TclDebug ("Stopping timer.");*/
2006 setitimer (ITIMER_REAL
, &it_off
, NULL
);
2007 sigaction (SIGALRM
, &act2
, NULL
);
2011 /* This hook function is called whenever we want to wait for the
2015 gdbtk_wait (pid
, ourstatus
)
2017 struct target_waitstatus
*ourstatus
;
2019 gdbtk_start_timer ();
2020 pid
= target_wait (pid
, ourstatus
);
2021 gdbtk_stop_timer ();
2025 /* This is called from execute_command, and provides a wrapper around
2026 various command routines in a place where both protocol messages and
2027 user input both flow through. Mostly this is used for indicating whether
2028 the target process is running or not.
2032 gdbtk_call_command (cmdblk
, arg
, from_tty
)
2033 struct cmd_list_element
*cmdblk
;
2038 if (cmdblk
->class == class_run
|| cmdblk
->class == class_trace
)
2041 /* HACK! HACK! This is to get the gui to update the tstart/tstop
2042 button only incase of tstart/tstop commands issued from the console
2043 We don't want to update the src window, so we need to have specific
2044 procedures to do tstart and tstop
2045 Unfortunately this will not display errors from tstart or tstop in the
2046 console window itself, but as dialogs.*/
2048 if (!strcmp(cmdblk
->name
, "tstart") && !No_Update
)
2050 Tcl_Eval (interp
, "gdbtk_tcl_tstart");
2051 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2053 else if (!strcmp(cmdblk
->name
, "tstop") && !No_Update
)
2055 Tcl_Eval (interp
, "gdbtk_tcl_tstop");
2056 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2063 Tcl_Eval (interp
, "gdbtk_tcl_busy");
2064 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2067 Tcl_Eval (interp
, "gdbtk_tcl_idle");
2071 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
2074 /* This function is called instead of gdb's internal command loop. This is the
2075 last chance to do anything before entering the main Tk event loop. */
2080 extern GDB_FILE
*instream
;
2082 /* We no longer want to use stdin as the command input stream */
2085 if (Tcl_Eval (interp
, "gdbtk_tcl_preloop") != TCL_OK
)
2089 /* Force errorInfo to be set up propertly. */
2090 Tcl_AddErrorInfo (interp
, "");
2092 msg
= Tcl_GetVar (interp
, "errorInfo", TCL_GLOBAL_ONLY
);
2094 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
2096 fputs_unfiltered (msg
, gdb_stderr
);
2107 /* gdbtk_init installs this function as a final cleanup. */
2110 gdbtk_cleanup (dummy
)
2114 struct ide_event_handle
*h
= (struct ide_event_handle
*) dummy
;
2116 ide_interface_deregister_all (h
);
2121 /* Initialize gdbtk. */
2124 gdbtk_init ( argv0
)
2127 struct cleanup
*old_chain
;
2128 char *lib
, *gdbtk_lib
, *gdbtk_lib_tmp
, *gdbtk_file
;
2131 struct sigaction action
;
2132 static sigset_t nullsigmask
= {0};
2135 /* start-sanitize-ide */
2136 struct ide_event_handle
*h
;
2139 /* end-sanitize-ide */
2142 /* If there is no DISPLAY environment variable, Tk_Init below will fail,
2143 causing gdb to abort. If instead we simply return here, gdb will
2144 gracefully degrade to using the command line interface. */
2147 if (getenv ("DISPLAY") == NULL
)
2151 old_chain
= make_cleanup (cleanup_init
, 0);
2153 /* First init tcl and tk. */
2154 Tcl_FindExecutable (argv0
);
2155 interp
= Tcl_CreateInterp ();
2157 #ifdef TCL_MEM_DEBUG
2158 Tcl_InitMemory (interp
);
2162 error ("Tcl_CreateInterp failed");
2164 if (Tcl_Init(interp
) != TCL_OK
)
2165 error ("Tcl_Init failed: %s", interp
->result
);
2168 /* For the IDE we register the cleanup later, after we've
2169 initialized events. */
2170 make_final_cleanup (gdbtk_cleanup
, NULL
);
2173 /* Initialize the Paths variable. */
2174 if (ide_initialize_paths (interp
, "gdbtcl") != TCL_OK
)
2175 error ("ide_initialize_paths failed: %s", interp
->result
);
2178 /* start-sanitize-ide */
2179 /* Find the directory where we expect to find idemanager. We ignore
2180 errors since it doesn't really matter if this fails. */
2181 libexecdir
= Tcl_GetVar2 (interp
, "Paths", "libexecdir", TCL_GLOBAL_ONLY
);
2185 h
= ide_event_init_from_environment (&errmsg
, libexecdir
);
2186 make_final_cleanup (gdbtk_cleanup
, h
);
2189 Tcl_AppendResult (interp
, "can't initialize event system: ", errmsg
,
2191 fprintf(stderr
, "WARNING: ide_event_init_client failed: %s\n", interp
->result
);
2193 Tcl_SetVar (interp
, "IDE_ENABLED", "0", 0);
2197 if (ide_create_tclevent_command (interp
, h
) != TCL_OK
)
2198 error ("ide_create_tclevent_command failed: %s", interp
->result
);
2200 if (ide_create_edit_command (interp
, h
) != TCL_OK
)
2201 error ("ide_create_edit_command failed: %s", interp
->result
);
2203 if (ide_create_property_command (interp
, h
) != TCL_OK
)
2204 error ("ide_create_property_command failed: %s", interp
->result
);
2206 if (ide_create_build_command (interp
, h
) != TCL_OK
)
2207 error ("ide_create_build_command failed: %s", interp
->result
);
2209 if (ide_create_window_register_command (interp
, h
, "gdb-restore")
2211 error ("ide_create_window_register_command failed: %s",
2214 if (ide_create_window_command (interp
, h
) != TCL_OK
)
2215 error ("ide_create_window_command failed: %s", interp
->result
);
2217 if (ide_create_exit_command (interp
, h
) != TCL_OK
)
2218 error ("ide_create_exit_command failed: %s", interp
->result
);
2220 if (ide_create_help_command (interp
) != TCL_OK
)
2221 error ("ide_create_help_command failed: %s", interp
->result
);
2224 if (ide_initialize (interp, "gdb") != TCL_OK)
2225 error ("ide_initialize failed: %s", interp->result);
2228 Tcl_SetVar (interp
, "IDE_ENABLED", "1", 0);
2230 /* end-sanitize-ide */
2232 Tcl_SetVar (interp
, "IDE_ENABLED", "0", 0);
2235 /* We don't want to open the X connection until we've done all the
2236 IDE initialization. Otherwise, goofy looking unfinished windows
2237 pop up when ILU drops into the TCL event loop. */
2239 if (Tk_Init(interp
) != TCL_OK
)
2240 error ("Tk_Init failed: %s", interp
->result
);
2242 if (Itcl_Init(interp
) == TCL_ERROR
)
2243 error ("Itcl_Init failed: %s", interp
->result
);
2245 if (Tix_Init(interp
) != TCL_OK
)
2246 error ("Tix_Init failed: %s", interp
->result
);
2248 if (Tktable_Init(interp
) != TCL_OK
)
2249 error ("Tktable_Init failed: %s", interp
->result
);
2250 Tcl_StaticPackage(interp
, "Tktable", Tktable_Init
,
2251 (Tcl_PackageInitProc
*) NULL
);
2254 if (ide_create_messagebox_command (interp
) != TCL_OK
)
2255 error ("messagebox command initialization failed");
2256 /* On Windows, create a sizebox widget command */
2257 if (ide_create_sizebox_command (interp
) != TCL_OK
)
2258 error ("sizebox creation failed");
2259 if (ide_create_winprint_command (interp
) != TCL_OK
)
2260 error ("windows print code initialization failed");
2261 /* start-sanitize-ide */
2262 /* An interface to ShellExecute. */
2263 if (ide_create_shell_execute_command (interp
) != TCL_OK
)
2264 error ("shell execute command initialization failed");
2265 /* end-sanitize-ide */
2266 if (ide_create_win_grab_command (interp
) != TCL_OK
)
2267 error ("grab support command initialization failed");
2268 /* Path conversion functions. */
2269 if (ide_create_cygwin_path_command (interp
) != TCL_OK
)
2270 error ("cygwin path command initialization failed");
2273 Tcl_CreateCommand (interp
, "gdb_cmd", call_wrapper
, gdb_cmd
, NULL
);
2274 Tcl_CreateCommand (interp
, "gdb_immediate", call_wrapper
,
2275 gdb_immediate_command
, NULL
);
2276 Tcl_CreateCommand (interp
, "gdb_loc", call_wrapper
, gdb_loc
, NULL
);
2277 Tcl_CreateCommand (interp
, "gdb_path_conv", call_wrapper
, gdb_path_conv
, NULL
);
2278 Tcl_CreateObjCommand (interp
, "gdb_listfiles", call_obj_wrapper
, gdb_listfiles
, NULL
);
2279 Tcl_CreateCommand (interp
, "gdb_listfuncs", call_wrapper
, gdb_listfuncs
,
2281 Tcl_CreateCommand (interp
, "gdb_get_mem", call_wrapper
, gdb_get_mem
,
2283 Tcl_CreateCommand (interp
, "gdb_stop", call_wrapper
, gdb_stop
, NULL
);
2284 Tcl_CreateCommand (interp
, "gdb_regnames", call_wrapper
, gdb_regnames
, NULL
);
2285 Tcl_CreateCommand (interp
, "gdb_fetch_registers", call_wrapper
,
2286 gdb_fetch_registers
, NULL
);
2287 Tcl_CreateCommand (interp
, "gdb_changed_register_list", call_wrapper
,
2288 gdb_changed_register_list
, NULL
);
2289 Tcl_CreateCommand (interp
, "gdb_disassemble", call_wrapper
,
2290 gdb_disassemble
, NULL
);
2291 Tcl_CreateCommand (interp
, "gdb_eval", call_wrapper
, gdb_eval
, NULL
);
2292 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_list", call_wrapper
,
2293 gdb_get_breakpoint_list
, NULL
);
2294 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_info", call_wrapper
,
2295 gdb_get_breakpoint_info
, NULL
);
2296 Tcl_CreateCommand (interp
, "gdb_clear_file", call_wrapper
,
2297 gdb_clear_file
, NULL
);
2298 Tcl_CreateCommand (interp
, "gdb_confirm_quit", call_wrapper
,
2299 gdb_confirm_quit
, NULL
);
2300 Tcl_CreateCommand (interp
, "gdb_force_quit", call_wrapper
,
2301 gdb_force_quit
, NULL
);
2302 Tcl_CreateCommand (interp
, "gdb_target_has_execution",
2303 gdb_target_has_execution_command
,
2305 Tcl_CreateCommand (interp
, "gdb_is_tracing",
2308 Tcl_CreateObjCommand (interp
, "gdb_load_info", call_obj_wrapper
, gdb_load_info
, NULL
);
2309 Tcl_CreateObjCommand (interp
, "gdb_get_locals", call_obj_wrapper
, gdb_get_locals_command
,
2311 Tcl_CreateObjCommand (interp
, "gdb_get_args", call_obj_wrapper
, gdb_get_args_command
,
2313 Tcl_CreateObjCommand (interp
, "gdb_get_function", call_obj_wrapper
, gdb_get_function_command
,
2315 Tcl_CreateObjCommand (interp
, "gdb_get_line", call_obj_wrapper
, gdb_get_line_command
,
2317 Tcl_CreateObjCommand (interp
, "gdb_get_file", call_obj_wrapper
, gdb_get_file_command
,
2319 Tcl_CreateObjCommand (interp
, "gdb_tracepoint_exists",
2320 call_obj_wrapper
, gdb_tracepoint_exists_command
, NULL
);
2321 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_info",
2322 call_obj_wrapper
, gdb_get_tracepoint_info
, NULL
);
2323 Tcl_CreateObjCommand (interp
, "gdb_actions",
2324 call_obj_wrapper
, gdb_actions_command
, NULL
);
2325 Tcl_CreateObjCommand (interp
, "gdb_prompt",
2326 call_obj_wrapper
, gdb_prompt_command
, NULL
);
2327 Tcl_CreateObjCommand (interp
, "gdb_find_file",
2328 call_obj_wrapper
, gdb_find_file_command
, NULL
);
2329 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_list",
2330 call_obj_wrapper
, gdb_get_tracepoint_list
, NULL
);
2331 Tcl_CreateCommand (interp
, "gdb_pc_reg", get_pc_register
, NULL
, NULL
);
2332 Tcl_CreateObjCommand (interp
, "gdb_loadfile", call_obj_wrapper
, gdb_loadfile
, NULL
);
2333 Tcl_CreateObjCommand (interp
, "gdb_set_bp", call_obj_wrapper
, gdb_set_bp
, NULL
);
2334 Tcl_CreateObjCommand (interp
, "gdb_get_trace_frame_num",
2335 call_obj_wrapper
, gdb_get_trace_frame_num
, NULL
);
2337 command_loop_hook
= tk_command_loop
;
2338 print_frame_info_listing_hook
= gdbtk_print_frame_info
;
2339 query_hook
= gdbtk_query
;
2340 warning_hook
= gdbtk_warning
;
2341 flush_hook
= gdbtk_flush
;
2342 create_breakpoint_hook
= gdbtk_create_breakpoint
;
2343 delete_breakpoint_hook
= gdbtk_delete_breakpoint
;
2344 modify_breakpoint_hook
= gdbtk_modify_breakpoint
;
2345 interactive_hook
= gdbtk_interactive
;
2346 target_wait_hook
= gdbtk_wait
;
2347 call_command_hook
= gdbtk_call_command
;
2348 readline_begin_hook
= gdbtk_readline_begin
;
2349 readline_hook
= gdbtk_readline
;
2350 readline_end_hook
= gdbtk_readline_end
;
2351 ui_load_progress_hook
= gdbtk_load_hash
;
2353 ui_loop_hook
= x_event
;
2355 pre_add_symbol_hook
= gdbtk_pre_add_symbol
;
2356 post_add_symbol_hook
= gdbtk_post_add_symbol
;
2357 create_tracepoint_hook
= gdbtk_create_tracepoint
;
2358 delete_tracepoint_hook
= gdbtk_delete_tracepoint
;
2359 modify_tracepoint_hook
= gdbtk_modify_tracepoint
;
2360 pc_changed_hook
= pc_changed
;
2362 add_com ("tk", class_obscure
, tk_command
,
2363 "Send a command directly into tk.");
2365 Tcl_LinkVar (interp
, "disassemble-from-exec", (char *)&disassemble_from_exec
,
2368 /* find the gdb tcl library and source main.tcl */
2370 gdbtk_lib
= getenv ("GDBTK_LIBRARY");
2372 if (access ("gdbtcl/main.tcl", R_OK
) == 0)
2373 gdbtk_lib
= "gdbtcl";
2375 gdbtk_lib
= GDBTK_LIBRARY
;
2377 gdbtk_lib_tmp
= xstrdup (gdbtk_lib
);
2380 /* see if GDBTK_LIBRARY is a path list */
2381 lib
= strtok (gdbtk_lib_tmp
, GDBTK_PATH_SEP
);
2384 if (Tcl_VarEval (interp
, "lappend auto_path ", lib
, NULL
) != TCL_OK
)
2386 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
2391 gdbtk_file
= concat (lib
, "/main.tcl", (char *) NULL
);
2392 if (access (gdbtk_file
, R_OK
) == 0)
2395 Tcl_SetVar (interp
, "GDBTK_LIBRARY", lib
, 0);
2399 while ((lib
= strtok (NULL
, ":")) != NULL
);
2401 free (gdbtk_lib_tmp
);
2405 /* Try finding it with the auto path. */
2407 static const char script
[] ="\
2408 proc gdbtk_find_main {} {\n\
2409 global auto_path GDBTK_LIBRARY\n\
2410 foreach dir $auto_path {\n\
2411 set f [file join $dir main.tcl]\n\
2412 if {[file exists $f]} then {\n\
2413 set GDBTK_LIBRARY $dir\n\
2421 if (Tcl_GlobalEval (interp
, (char *) script
) != TCL_OK
)
2423 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
2427 if (interp
->result
[0] != '\0')
2429 gdbtk_file
= xstrdup (interp
->result
);
2436 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
2437 if (getenv("GDBTK_LIBRARY"))
2439 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
2440 fprintf_unfiltered (stderr
,
2441 "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
2445 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY
);
2446 fprintf_unfiltered (stderr
, "You might want to set GDBTK_LIBRARY\n");
2451 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
2452 prior to this point go to stdout/stderr. */
2454 fputs_unfiltered_hook
= gdbtk_fputs
;
2456 /* start-sanitize-tclpro */
2457 #ifdef TCLPRO_DEBUGGER
2459 Tcl_DString source_cmd
;
2461 Tcl_DStringInit (&source_cmd
);
2462 Tcl_DStringAppend (&source_cmd
,
2463 "if {[info exists env(TCLPRO_DEBUG_DIR)]} {source [file join $env(TCLPRO_DEBUG_DIR) src loader.tcl];", -1);
2464 Tcl_DStringAppend (&source_cmd
, "debugger_init; debugger_eval {source {", -1);
2465 Tcl_DStringAppend (&source_cmd
, gdbtk_file
, -1);
2466 Tcl_DStringAppend (&source_cmd
, "}}} else {source {", -1);
2467 Tcl_DStringAppend (&source_cmd
, gdbtk_file
, -1);
2468 Tcl_DStringAppend (&source_cmd
, "}}", -1);
2469 if (Tcl_GlobalEval (interp
, Tcl_DStringValue (&source_cmd
)) != TCL_OK
)
2471 /* end-sanitize-tclpro */
2472 if (Tcl_EvalFile (interp
, gdbtk_file
) != TCL_OK
)
2473 /* start-sanitize-tclpro */
2475 /* end-sanitize-tclpro */
2479 /* Force errorInfo to be set up propertly. */
2480 Tcl_AddErrorInfo (interp
, "");
2482 msg
= Tcl_GetVar (interp
, "errorInfo", TCL_GLOBAL_ONLY
);
2484 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
2487 MessageBox (NULL
, msg
, NULL
, MB_OK
| MB_ICONERROR
| MB_TASKMODAL
);
2489 fputs_unfiltered (msg
, gdb_stderr
);
2494 /* start-sanitize-tclpro */
2495 #ifdef TCLPRO_DEBUGGER
2496 Tcl_DStringFree(&source_cmd
);
2499 /* end-sanitize-tclpro */
2502 /* start-sanitize-ide */
2503 /* Don't do this until we have initialized. Otherwise, we may get a
2504 run command before we are ready for one. */
2505 if (ide_run_server_init (interp
, h
) != TCL_OK
)
2506 error ("ide_run_server_init failed: %s", interp
->result
);
2507 /* end-sanitize-ide */
2512 discard_cleanups (old_chain
);
2516 gdb_target_has_execution_command (clientData
, interp
, argc
, argv
)
2517 ClientData clientData
;
2524 if (target_has_execution
&& inferior_pid
!= 0)
2527 Tcl_SetIntObj (Tcl_GetObjResult (interp
), result
);
2532 gdb_trace_status (clientData
, interp
, argc
, argv
)
2533 ClientData clientData
;
2540 if (trace_running_p
)
2543 Tcl_SetIntObj (Tcl_GetObjResult (interp
), result
);
2547 /* gdb_load_info - returns information about the file about to be downloaded */
2550 gdb_load_info (clientData
, interp
, objc
, objv
)
2551 ClientData clientData
;
2554 Tcl_Obj
*CONST objv
[];
2557 struct cleanup
*old_cleanups
;
2563 char *filename
= Tcl_GetStringFromObj (objv
[1], NULL
);
2565 loadfile_bfd
= bfd_openr (filename
, gnutarget
);
2566 if (loadfile_bfd
== NULL
)
2568 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("Open failed", -1));
2571 old_cleanups
= make_cleanup (bfd_close
, loadfile_bfd
);
2573 if (!bfd_check_format (loadfile_bfd
, bfd_object
))
2575 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("Bad Object File", -1));
2579 for (s
= loadfile_bfd
->sections
; s
; s
= s
->next
)
2581 if (s
->flags
& SEC_LOAD
)
2583 bfd_size_type size
= bfd_get_section_size_before_reloc (s
);
2586 ob
[0] = Tcl_NewStringObj((char *)bfd_get_section_name(loadfile_bfd
, s
), -1);
2587 ob
[1] = Tcl_NewLongObj ((long)size
);
2588 res
[i
++] = Tcl_NewListObj (2, ob
);
2593 Tcl_SetObjResult (interp
, Tcl_NewListObj (i
, res
));
2594 do_cleanups (old_cleanups
);
2600 gdbtk_load_hash (section
, num
)
2605 sprintf (buf
, "download_hash %s %ld", section
, num
);
2606 Tcl_Eval (interp
, buf
);
2607 return atoi (interp
->result
);
2611 * This and gdb_get_locals just call gdb_get_vars_command with the right
2612 * value of clientData. We can't use the client data in the definition
2613 * of the command, because the call wrapper uses this instead...
2617 gdb_get_locals_command (clientData
, interp
, objc
, objv
)
2618 ClientData clientData
;
2621 Tcl_Obj
*CONST objv
[];
2624 return gdb_get_vars_command((ClientData
) 0, interp
, objc
, objv
);
2629 gdb_get_args_command (clientData
, interp
, objc
, objv
)
2630 ClientData clientData
;
2633 Tcl_Obj
*CONST objv
[];
2636 return gdb_get_vars_command((ClientData
) 1, interp
, objc
, objv
);
2640 /* gdb_get_vars_command -
2642 * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
2643 * function sets the Tcl interpreter's result to a list of variable names
2644 * depending on clientData. If clientData is one, the result is a list of
2645 * arguments; zero returns a list of locals -- all relative to the block
2646 * specified as an argument to the command. Valid commands include
2647 * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
2651 gdb_get_vars_command (clientData
, interp
, objc
, objv
)
2652 ClientData clientData
;
2655 Tcl_Obj
*CONST objv
[];
2658 struct symtabs_and_lines sals
;
2660 struct block
*block
;
2661 char **canonical
, *args
;
2662 int i
, nsyms
, arguments
;
2666 Tcl_AppendResult (interp
,
2667 "wrong # of args: should be \"",
2668 Tcl_GetStringFromObj (objv
[0], NULL
),
2669 " function:line|function|line|*addr\"");
2673 arguments
= (int) clientData
;
2674 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2675 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2676 if (sals
.nelts
== 0)
2678 Tcl_AppendResult (interp
,
2679 "error decoding line", NULL
);
2683 /* Initialize a list that will hold the results */
2684 result
= Tcl_NewListObj (0, NULL
);
2686 /* Resolve all line numbers to PC's */
2687 for (i
= 0; i
< sals
.nelts
; i
++)
2688 resolve_sal_pc (&sals
.sals
[i
]);
2690 block
= block_for_pc (sals
.sals
[0].pc
);
2693 nsyms
= BLOCK_NSYMS (block
);
2694 for (i
= 0; i
< nsyms
; i
++)
2696 sym
= BLOCK_SYM (block
, i
);
2697 switch (SYMBOL_CLASS (sym
)) {
2699 case LOC_UNDEF
: /* catches errors */
2700 case LOC_CONST
: /* constant */
2701 case LOC_TYPEDEF
: /* local typedef */
2702 case LOC_LABEL
: /* local label */
2703 case LOC_BLOCK
: /* local function */
2704 case LOC_CONST_BYTES
: /* loc. byte seq. */
2705 case LOC_UNRESOLVED
: /* unresolved static */
2706 case LOC_OPTIMIZED_OUT
: /* optimized out */
2708 case LOC_ARG
: /* argument */
2709 case LOC_REF_ARG
: /* reference arg */
2710 case LOC_REGPARM
: /* register arg */
2711 case LOC_REGPARM_ADDR
: /* indirect register arg */
2712 case LOC_LOCAL_ARG
: /* stack arg */
2713 case LOC_BASEREG_ARG
: /* basereg arg */
2715 Tcl_ListObjAppendElement (interp
, result
,
2716 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
2718 case LOC_LOCAL
: /* stack local */
2719 case LOC_STATIC
: /* static */
2720 case LOC_REGISTER
: /* register */
2721 case LOC_BASEREG
: /* basereg local */
2723 Tcl_ListObjAppendElement (interp
, result
,
2724 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
2728 if (BLOCK_FUNCTION (block
))
2731 block
= BLOCK_SUPERBLOCK (block
);
2734 Tcl_SetObjResult (interp
, result
);
2739 gdb_get_line_command (clientData
, interp
, objc
, objv
)
2740 ClientData clientData
;
2743 Tcl_Obj
*CONST objv
[];
2746 struct symtabs_and_lines sals
;
2747 char *args
, **canonical
;
2751 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2752 Tcl_GetStringFromObj (objv
[0], NULL
),
2757 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2758 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2759 if (sals
.nelts
== 1)
2761 Tcl_SetObjResult (interp
, Tcl_NewIntObj (sals
.sals
[0].line
));
2765 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2771 gdb_get_trace_frame_num (clientData
, interp
, objc
, objv
)
2772 ClientData clientData
;
2775 Tcl_Obj
*CONST objv
[];
2779 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2780 Tcl_GetStringFromObj (objv
[0], NULL
),
2785 Tcl_SetObjResult (interp
, Tcl_NewIntObj (get_traceframe_number ()));
2792 gdb_get_file_command (clientData
, interp
, objc
, objv
)
2793 ClientData clientData
;
2796 Tcl_Obj
*CONST objv
[];
2799 struct symtabs_and_lines sals
;
2800 char *args
, **canonical
;
2804 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2805 Tcl_GetStringFromObj (objv
[0], NULL
),
2810 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2811 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2812 if (sals
.nelts
== 1)
2814 Tcl_SetResult (interp
, sals
.sals
[0].symtab
->filename
, TCL_VOLATILE
);
2818 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2823 gdb_get_function_command (clientData
, interp
, objc
, objv
)
2824 ClientData clientData
;
2827 Tcl_Obj
*CONST objv
[];
2831 struct symtabs_and_lines sals
;
2832 char *args
, **canonical
;
2836 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
2837 Tcl_GetStringFromObj (objv
[0], NULL
),
2842 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
2843 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
2844 if (sals
.nelts
== 1)
2846 resolve_sal_pc (&sals
.sals
[0]);
2847 find_pc_partial_function (sals
.sals
[0].pc
, &function
, NULL
, NULL
);
2848 if (function
!= NULL
)
2850 Tcl_SetResult (interp
, function
, TCL_VOLATILE
);
2855 Tcl_SetResult (interp
, "N/A", TCL_STATIC
);
2860 gdb_get_tracepoint_info (clientData
, interp
, objc
, objv
)
2861 ClientData clientData
;
2864 Tcl_Obj
*CONST objv
[];
2866 struct symtab_and_line sal
;
2868 struct tracepoint
*tp
;
2869 struct action_line
*al
;
2870 Tcl_Obj
*list
, *action_list
;
2871 char *filename
, *funcname
;
2875 error ("wrong # args");
2877 Tcl_GetIntFromObj (NULL
, objv
[1], &tpnum
);
2879 ALL_TRACEPOINTS (tp
)
2880 if (tp
->number
== tpnum
)
2884 error ("Tracepoint #%d does not exist", tpnum
);
2886 list
= Tcl_NewListObj (0, NULL
);
2887 sal
= find_pc_line (tp
->address
, 0);
2888 filename
= symtab_to_filename (sal
.symtab
);
2889 if (filename
== NULL
)
2891 Tcl_ListObjAppendElement (interp
, list
,
2892 Tcl_NewStringObj (filename
, -1));
2893 find_pc_partial_function (tp
->address
, &funcname
, NULL
, NULL
);
2894 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewStringObj (funcname
, -1));
2895 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (sal
.line
));
2896 sprintf (tmp
, "0x%lx", tp
->address
);
2897 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewStringObj (tmp
, -1));
2898 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->enabled
));
2899 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->pass_count
));
2900 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->step_count
));
2901 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->thread
));
2902 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->hit_count
));
2904 /* Append a list of actions */
2905 action_list
= Tcl_NewListObj (0, NULL
);
2906 for (al
= tp
->actions
; al
!= NULL
; al
= al
->next
)
2908 Tcl_ListObjAppendElement (interp
, action_list
,
2909 Tcl_NewStringObj (al
->action
, -1));
2911 Tcl_ListObjAppendElement (interp
, list
, action_list
);
2913 Tcl_SetObjResult (interp
, list
);
2918 /* TclDebug (const char *fmt, ...) works just like printf() but */
2919 /* sends the output to the GDB TK debug window. */
2920 /* Not for normal use; just a convenient tool for debugging */
2922 #ifdef ANSI_PROTOTYPES
2923 TclDebug (const char *fmt
, ...)
2930 char buf
[512], *v
[2], *merge
;
2932 #ifdef ANSI_PROTOTYPES
2933 va_start (args
, fmt
);
2937 fmt
= va_arg (args
, char *);
2943 vsprintf (buf
, fmt
, args
);
2946 merge
= Tcl_Merge (2, v
);
2947 Tcl_Eval (interp
, merge
);
2952 /* Find the full pathname to a file, searching the symbol tables */
2955 gdb_find_file_command (clientData
, interp
, objc
, objv
)
2956 ClientData clientData
;
2959 Tcl_Obj
*CONST objv
[];
2961 char *filename
= NULL
;
2966 Tcl_WrongNumArgs(interp
, 1, objv
, "filename");
2970 st
= full_lookup_symtab (Tcl_GetStringFromObj (objv
[1], NULL
));
2972 filename
= st
->fullname
;
2974 if (filename
== NULL
)
2975 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("", 0));
2977 Tcl_SetObjResult (interp
, Tcl_NewStringObj (filename
, -1));
2983 gdbtk_create_tracepoint (tp
)
2984 struct tracepoint
*tp
;
2986 tracepoint_notify (tp
, "create");
2990 gdbtk_delete_tracepoint (tp
)
2991 struct tracepoint
*tp
;
2993 tracepoint_notify (tp
, "delete");
2997 gdbtk_modify_tracepoint (tp
)
2998 struct tracepoint
*tp
;
3000 tracepoint_notify (tp
, "modify");
3004 tracepoint_notify(tp
, action
)
3005 struct tracepoint
*tp
;
3010 struct symtab_and_line sal
;
3013 /* We ensure that ACTION contains no special Tcl characters, so we
3015 sal
= find_pc_line (tp
->address
, 0);
3017 filename
= symtab_to_filename (sal
.symtab
);
3018 if (filename
== NULL
)
3020 sprintf (buf
, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action
, tp
->number
,
3021 (long)tp
->address
, sal
.line
, filename
, tp
->pass_count
);
3023 v
= Tcl_Eval (interp
, buf
);
3027 gdbtk_fputs (interp
->result
, gdb_stdout
);
3028 gdbtk_fputs ("\n", gdb_stdout
);
3032 /* returns -1 if not found, tracepoint # if found */
3034 tracepoint_exists (char * args
)
3036 struct tracepoint
*tp
;
3038 struct symtabs_and_lines sals
;
3042 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
3043 if (sals
.nelts
== 1)
3045 resolve_sal_pc (&sals
.sals
[0]);
3046 file
= xmalloc (strlen (sals
.sals
[0].symtab
->dirname
)
3047 + strlen (sals
.sals
[0].symtab
->filename
) + 1);
3050 strcpy (file
, sals
.sals
[0].symtab
->dirname
);
3051 strcat (file
, sals
.sals
[0].symtab
->filename
);
3053 ALL_TRACEPOINTS (tp
)
3055 if (tp
->address
== sals
.sals
[0].pc
)
3056 result
= tp
->number
;
3058 /* Why is this here? This messes up assembly traces */
3059 else if (tp
->source_file
!= NULL
3060 && strcmp (tp
->source_file
, file
) == 0
3061 && sals
.sals
[0].line
== tp
->line_number
)
3062 result
= tp
->number
;
3073 gdb_actions_command (clientData
, interp
, objc
, objv
)
3074 ClientData clientData
;
3077 Tcl_Obj
*CONST objv
[];
3079 struct tracepoint
*tp
;
3081 int nactions
, i
, len
;
3082 char *number
, *args
, *action
;
3084 struct action_line
*next
= NULL
, *temp
;
3085 enum actionline_type linetype
;
3089 Tcl_AppendResult (interp
, "wrong # args: should be: \"",
3090 Tcl_GetStringFromObj (objv
[0], NULL
),
3091 " number actions\"");
3095 args
= number
= Tcl_GetStringFromObj (objv
[1], NULL
);
3096 tp
= get_tracepoint_by_number (&args
);
3099 Tcl_AppendResult (interp
, "Tracepoint \"", number
, "\" does not exist");
3103 /* Free any existing actions */
3104 if (tp
->actions
!= NULL
)
3109 Tcl_ListObjGetElements (interp
, objv
[2], &nactions
, &actions
);
3111 /* Add the actions to the tracepoint */
3112 for (i
= 0; i
< nactions
; i
++)
3114 temp
= xmalloc (sizeof (struct action_line
));
3116 action
= Tcl_GetStringFromObj (actions
[i
], &len
);
3117 temp
->action
= savestring (action
, len
);
3119 linetype
= validate_actionline (&(temp
->action
), tp
);
3121 if (linetype
== BADLINE
)
3143 gdb_tracepoint_exists_command (clientData
, interp
, objc
, objv
)
3144 ClientData clientData
;
3147 Tcl_Obj
*CONST objv
[];
3153 Tcl_AppendResult (interp
, "wrong # of args: should be \"",
3154 Tcl_GetStringFromObj (objv
[0], NULL
),
3155 " function:line|function|line|*addr\"");
3159 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
3161 Tcl_SetObjResult (interp
, Tcl_NewIntObj (tracepoint_exists (args
)));
3165 /* Return the prompt to the interpreter */
3167 gdb_prompt_command (clientData
, interp
, objc
, objv
)
3168 ClientData clientData
;
3171 Tcl_Obj
*CONST objv
[];
3173 Tcl_SetResult (interp
, get_prompt (), TCL_VOLATILE
);
3177 /* return a list of all tracepoint numbers in interpreter */
3179 gdb_get_tracepoint_list (clientData
, interp
, objc
, objv
)
3180 ClientData clientData
;
3183 Tcl_Obj
*CONST objv
[];
3186 struct tracepoint
*tp
;
3188 list
= Tcl_NewListObj (0, NULL
);
3190 ALL_TRACEPOINTS (tp
)
3191 Tcl_ListObjAppendElement (interp
, list
, Tcl_NewIntObj (tp
->number
));
3193 Tcl_SetObjResult (interp
, list
);
3198 /* This hook is called whenever we are ready to load a symbol file so that
3199 the UI can notify the user... */
3201 gdbtk_pre_add_symbol (name
)
3206 v
[0] = "gdbtk_tcl_pre_add_symbol";
3208 merge
= Tcl_Merge (2, v
);
3209 Tcl_Eval (interp
, merge
);
3213 /* This hook is called whenever we finish loading a symbol file. */
3215 gdbtk_post_add_symbol ()
3217 Tcl_Eval (interp
, "gdbtk_tcl_post_add_symbol");
3223 gdbtk_print_frame_info (s
, line
, stopline
, noerror
)
3229 current_source_symtab
= s
;
3230 current_source_line
= line
;
3234 /* The lookup_symtab() in symtab.c doesn't work correctly */
3235 /* It will not work will full pathnames and if multiple */
3236 /* source files have the same basename, it will return */
3237 /* the first one instead of the correct one. This version */
3238 /* also always makes sure symtab->fullname is set. */
3240 static struct symtab
*
3241 full_lookup_symtab(file
)
3245 struct objfile
*objfile
;
3246 char *bfile
, *fullname
;
3247 struct partial_symtab
*pt
;
3252 /* first try a direct lookup */
3253 st
= lookup_symtab (file
);
3257 symtab_to_filename(st
);
3261 /* if the direct approach failed, try */
3262 /* looking up the basename and checking */
3263 /* all matches with the fullname */
3264 bfile
= basename (file
);
3265 ALL_SYMTABS (objfile
, st
)
3267 if (!strcmp (bfile
, basename(st
->filename
)))
3270 fullname
= symtab_to_filename (st
);
3272 fullname
= st
->fullname
;
3274 if (!strcmp (file
, fullname
))
3279 /* still no luck? look at psymtabs */
3280 ALL_PSYMTABS (objfile
, pt
)
3282 if (!strcmp (bfile
, basename(pt
->filename
)))
3284 st
= PSYMTAB_TO_SYMTAB (pt
);
3287 fullname
= symtab_to_filename (st
);
3288 if (!strcmp (file
, fullname
))
3297 perror_with_name_wrapper (args
)
3300 perror_with_name (args
);
3304 /* gdb_loadfile loads a c source file into a text widget. */
3306 /* LTABLE_SIZE is the number of bytes to allocate for the */
3307 /* line table. Its size limits the maximum number of lines */
3308 /* in a file to 8 * LTABLE_SIZE. This memory is freed after */
3309 /* the file is loaded, so it is OK to make this very large. */
3310 /* Additional memory will be allocated if needed. */
3311 #define LTABLE_SIZE 20000
3314 gdb_loadfile (clientData
, interp
, objc
, objv
)
3315 ClientData clientData
;
3318 Tcl_Obj
*CONST objv
[];
3320 char *file
, *widget
, *line
, *buf
, msg
[128];
3321 int linenumbers
, ln
, anum
, lnum
, ltable_size
;
3322 Tcl_Obj
*a
[2], *b
[2], *cmd
;
3325 struct symtab
*symtab
;
3326 struct linetable_entry
*le
;
3333 Tcl_WrongNumArgs(interp
, 1, objv
, "widget filename linenumbers");
3337 widget
= Tcl_GetStringFromObj (objv
[1], NULL
);
3338 file
= Tcl_GetStringFromObj (objv
[2], NULL
);
3339 Tcl_GetBooleanFromObj (interp
, objv
[3], &linenumbers
);
3341 if ((fp
= fopen ( file
, "r" )) == NULL
)
3344 symtab
= full_lookup_symtab (file
);
3347 sprintf(msg
, "File not found");
3348 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3353 if (stat (file
, &st
) < 0)
3355 catch_errors (perror_with_name_wrapper
, "gdbtk: get time stamp", "",
3360 if (symtab
&& symtab
->objfile
&& symtab
->objfile
->obfd
)
3361 mtime
= bfd_get_mtime(symtab
->objfile
->obfd
);
3363 mtime
= bfd_get_mtime(exec_bfd
);
3365 if (mtime
&& mtime
< st
.st_mtime
)
3366 gdbtk_ignorable_warning("Source file is more recent than executable.\n");
3369 /* Source linenumbers don't appear to be in order, and a sort is */
3370 /* too slow so the fastest solution is just to allocate a huge */
3371 /* array and set the array entry for each linenumber */
3373 ltable_size
= LTABLE_SIZE
;
3374 ltable
= (char *)malloc (LTABLE_SIZE
);
3377 sprintf(msg
, "Out of memory.");
3378 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3383 memset (ltable
, 0, LTABLE_SIZE
);
3385 if (symtab
->linetable
&& symtab
->linetable
->nitems
)
3387 le
= symtab
->linetable
->item
;
3388 for (ln
= symtab
->linetable
->nitems
;ln
> 0; ln
--, le
++)
3390 lnum
= le
->line
>> 3;
3391 if (lnum
>= ltable_size
)
3394 new_ltable
= (char *)realloc (ltable
, ltable_size
*2);
3395 memset (new_ltable
+ ltable_size
, 0, ltable_size
);
3397 if (new_ltable
== NULL
)
3399 sprintf(msg
, "Out of memory.");
3400 Tcl_SetStringObj ( Tcl_GetObjResult (interp
), msg
, -1);
3405 ltable
= new_ltable
;
3407 ltable
[lnum
] |= 1 << (le
->line
% 8);
3411 /* create an object with enough space, then grab its */
3412 /* buffer and sprintf directly into it. */
3413 a
[0] = Tcl_NewStringObj (ltable
, 1024);
3414 a
[1] = Tcl_NewListObj(0,NULL
);
3416 b
[0] = Tcl_NewStringObj (ltable
,1024);
3417 b
[1] = Tcl_NewStringObj ("source_tag", -1);
3418 Tcl_IncrRefCount (b
[0]);
3419 Tcl_IncrRefCount (b
[1]);
3420 line
= b
[0]->bytes
+ 1;
3421 strcpy(b
[0]->bytes
,"\t");
3424 while (fgets (line
, 980, fp
))
3428 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
3430 sprintf (buf
,"%s insert end {-\t%d} break_tag", widget
, ln
);
3431 a
[0]->length
= strlen (buf
);
3435 sprintf (buf
,"%s insert end { \t%d} \"\"", widget
, ln
);
3436 a
[0]->length
= strlen (buf
);
3441 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
3443 sprintf (buf
,"%s insert end {-\t} break_tag", widget
);
3444 a
[0]->length
= strlen (buf
);
3448 sprintf (buf
,"%s insert end { \t} \"\"", widget
);
3449 a
[0]->length
= strlen (buf
);
3452 b
[0]->length
= strlen(b
[0]->bytes
);
3453 Tcl_SetListObj(a
[1],2,b
);
3454 cmd
= Tcl_ConcatObj(2,a
);
3455 Tcl_EvalObj (interp
, cmd
);
3456 Tcl_DecrRefCount (cmd
);
3459 Tcl_DecrRefCount (b
[0]);
3460 Tcl_DecrRefCount (b
[0]);
3461 Tcl_DecrRefCount (b
[1]);
3462 Tcl_DecrRefCount (b
[1]);
3468 /* at some point make these static in breakpoint.c and move GUI code there */
3469 extern struct breakpoint
*set_raw_breakpoint (struct symtab_and_line sal
);
3470 extern void set_breakpoint_count (int);
3471 extern int breakpoint_count
;
3473 /* set a breakpoint by source file and line number */
3474 /* flags are as follows: */
3475 /* least significant 2 bits are disposition, rest is */
3476 /* type (normally 0).
3479 bp_breakpoint, Normal breakpoint
3480 bp_hardware_breakpoint, Hardware assisted breakpoint
3483 Disposition of breakpoint. Ie: what to do after hitting it.
3486 del_at_next_stop, Delete at next stop, whether hit or not
3488 donttouch Leave it alone
3493 gdb_set_bp (clientData
, interp
, objc
, objv
)
3494 ClientData clientData
;
3497 Tcl_Obj
*CONST objv
[];
3500 struct symtab_and_line sal
;
3501 int line
, flags
, ret
;
3502 struct breakpoint
*b
;
3504 Tcl_Obj
*a
[5], *cmd
;
3508 Tcl_WrongNumArgs(interp
, 1, objv
, "filename line type");
3512 sal
.symtab
= full_lookup_symtab (Tcl_GetStringFromObj( objv
[1], NULL
));
3513 if (sal
.symtab
== NULL
)
3516 if (Tcl_GetIntFromObj( interp
, objv
[2], &line
) == TCL_ERROR
)
3519 if (Tcl_GetIntFromObj( interp
, objv
[3], &flags
) == TCL_ERROR
)
3523 sal
.pc
= find_line_pc (sal
.symtab
, sal
.line
);
3527 sal
.section
= find_pc_overlay (sal
.pc
);
3528 b
= set_raw_breakpoint (sal
);
3529 set_breakpoint_count (breakpoint_count
+ 1);
3530 b
->number
= breakpoint_count
;
3531 b
->type
= flags
>> 2;
3532 b
->disposition
= flags
& 3;
3534 /* FIXME: this won't work for duplicate basenames! */
3535 sprintf (buf
, "%s:%d", basename(Tcl_GetStringFromObj( objv
[1], NULL
)), line
);
3536 b
->addr_string
= strsave (buf
);
3538 /* now send notification command back to GUI */
3539 sprintf (buf
, "0x%x", sal
.pc
);
3540 a
[0] = Tcl_NewStringObj ("gdbtk_tcl_breakpoint create", -1);
3541 a
[1] = Tcl_NewIntObj (b
->number
);
3542 a
[2] = Tcl_NewStringObj (buf
, -1);
3544 a
[4] = Tcl_NewListObj (1,&objv
[1]);
3545 cmd
= Tcl_ConcatObj(5,a
);
3546 ret
= Tcl_EvalObj (interp
, cmd
);
3547 Tcl_DecrRefCount (cmd
);
3551 /* Come here during initialize_all_files () */
3554 _initialize_gdbtk ()
3558 /* Tell the rest of the world that Gdbtk is now set up. */
3560 init_ui_hook
= gdbtk_init
;
3562 (void) FreeConsole ();
3568 DWORD ft
= GetFileType (GetStdHandle (STD_INPUT_HANDLE
));
3569 void cygwin32_attach_handle_to_fd (char *, int, HANDLE
, int, int);
3573 case FILE_TYPE_DISK
:
3574 case FILE_TYPE_CHAR
:
3575 case FILE_TYPE_PIPE
:
3579 cygwin32_attach_handle_to_fd ("/dev/conin", 0,
3580 GetStdHandle (STD_INPUT_HANDLE
),
3582 cygwin32_attach_handle_to_fd ("/dev/conout", 1,
3583 GetStdHandle (STD_OUTPUT_HANDLE
),
3585 cygwin32_attach_handle_to_fd ("/dev/conout", 2,
3586 GetStdHandle (STD_ERROR_HANDLE
),