1 /* Tcl/Tk interface routines.
2 Copyright 1994, 1995, 1996, 1997 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. */
32 /* #include <itcl.h> */
33 #ifdef ANSI_PROTOTYPES
43 #include <sys/ioctl.h>
44 #include "gdb_string.h"
51 #include <sys/stropts.h>
56 #define GDBTK_PATH_SEP ";"
58 #define GDBTK_PATH_SEP ":"
61 /* Some versions (1.3.79, 1.3.81) of Linux don't support SIOCSPGRP the way
62 gdbtk wants to use it... */
67 static void null_routine
PARAMS ((int));
68 static void gdbtk_flush
PARAMS ((FILE *));
69 static void gdbtk_fputs
PARAMS ((const char *, FILE *));
70 static int gdbtk_query
PARAMS ((const char *, va_list));
71 static char *gdbtk_readline
PARAMS ((char *));
72 static void gdbtk_init
PARAMS ((void));
73 static void tk_command_loop
PARAMS ((void));
74 static void gdbtk_call_command
PARAMS ((struct cmd_list_element
*, char *, int));
75 static int gdbtk_wait
PARAMS ((int, struct target_waitstatus
*));
76 static void x_event
PARAMS ((int));
77 static void gdbtk_interactive
PARAMS ((void));
78 static void cleanup_init
PARAMS ((int));
79 static void tk_command
PARAMS ((char *, int));
80 static int gdb_disassemble
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
81 static int compare_lines
PARAMS ((const PTR
, const PTR
));
82 static int gdbtk_dis_asm_read_memory
PARAMS ((bfd_vma
, bfd_byte
*, int, disassemble_info
*));
83 static int gdb_path_conv
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
84 static int gdb_stop
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
85 static int gdb_listfiles
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
86 static int call_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
87 static int gdb_cmd
PARAMS ((ClientData
, Tcl_Interp
*, int, char *argv
[]));
88 static int gdb_fetch_registers
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
89 static void gdbtk_readline_end
PARAMS ((void));
90 static int gdb_changed_register_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
91 static void register_changed_p
PARAMS ((int, void *));
92 static int gdb_get_breakpoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
93 static int gdb_get_breakpoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
94 static void breakpoint_notify
PARAMS ((struct breakpoint
*, const char *));
95 static void gdbtk_create_breakpoint
PARAMS ((struct breakpoint
*));
96 static void gdbtk_delete_breakpoint
PARAMS ((struct breakpoint
*));
97 static void gdbtk_modify_breakpoint
PARAMS ((struct breakpoint
*));
98 static int gdb_loc
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
99 static int gdb_eval
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
100 static int gdb_sourcelines
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
101 static int map_arg_registers
PARAMS ((int, char *[], void (*) (int, void *), void *));
102 static void get_register_name
PARAMS ((int, void *));
103 static int gdb_regnames
PARAMS ((ClientData
, Tcl_Interp
*, int, char *[]));
104 static void get_register
PARAMS ((int, void *));
106 /* Handle for TCL interpreter */
108 static Tcl_Interp
*interp
= NULL
;
110 static int x_fd
; /* X network socket */
112 /* This variable is true when the inferior is running. Although it's
113 possible to disable most input from widgets and thus prevent
114 attempts to do anything while the inferior is running, any commands
115 that get through - even a simple memory read - are Very Bad, and
116 may cause GDB to crash or behave strangely. So, this variable
117 provides an extra layer of defense. */
119 static int running_now
;
121 /* This variable determines where memory used for disassembly is read from.
122 If > 0, then disassembly comes from the exec file rather than the
123 target (which might be at the other end of a slow serial link). If
124 == 0 then disassembly comes from target. If < 0 disassembly is
125 automatically switched to the target if it's an inferior process,
126 otherwise the exec file is used. */
128 static int disassemble_from_exec
= -1;
130 static char *Gdbtk_Library
;
132 /* Supply malloc calls for tcl/tk. */
138 return xmalloc (size
);
142 Tcl_Realloc (ptr
, size
)
146 return xrealloc (ptr
, size
);
162 /* The following routines deal with stdout/stderr data, which is created by
163 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
164 lowest level of these routines and capture all output from the rest of GDB.
165 Normally they present their data to tcl via callbacks to the following tcl
166 routines: gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush. These
167 in turn call tk routines to update the display.
169 Under some circumstances, you may want to collect the output so that it can
170 be returned as the value of a tcl procedure. This can be done by
171 surrounding the output routines with calls to start_saving_output and
172 finish_saving_output. The saved data can then be retrieved with
173 get_saved_output (but this must be done before the call to
174 finish_saving_output). */
176 /* Dynamic string header for stdout. */
178 static Tcl_DString
*result_ptr
;
185 /* Force immediate screen update */
187 Tcl_VarEval (interp
, "gdbtk_tcl_flush", NULL
);
192 gdbtk_fputs (ptr
, stream
)
198 Tcl_DStringAppend (result_ptr
, (char *)ptr
, -1);
203 Tcl_DStringInit (&str
);
205 Tcl_DStringAppend (&str
, "gdbtk_tcl_fputs", -1);
206 Tcl_DStringAppendElement (&str
, (char *)ptr
);
208 Tcl_Eval (interp
, Tcl_DStringValue (&str
));
209 Tcl_DStringFree (&str
);
214 gdbtk_query (query
, args
)
218 char buf
[200], *merge
[2];
222 vsprintf (buf
, query
, args
);
223 merge
[0] = "gdbtk_tcl_query";
225 command
= Tcl_Merge (2, merge
);
226 Tcl_Eval (interp
, command
);
229 val
= atol (interp
->result
);
235 #ifdef ANSI_PROTOTYPES
236 gdbtk_readline_begin (char *format
, ...)
238 gdbtk_readline_begin (va_alist
)
243 char buf
[200], *merge
[2];
246 #ifdef ANSI_PROTOTYPES
247 va_start (args
, format
);
251 format
= va_arg (args
, char *);
254 vsprintf (buf
, format
, args
);
255 merge
[0] = "gdbtk_tcl_readline_begin";
257 command
= Tcl_Merge (2, merge
);
258 Tcl_Eval (interp
, command
);
263 gdbtk_readline (prompt
)
270 merge
[0] = "gdbtk_tcl_readline";
272 command
= Tcl_Merge (2, merge
);
273 result
= Tcl_Eval (interp
, command
);
275 if (result
== TCL_OK
)
277 return (strdup (interp
-> result
));
281 gdbtk_fputs (interp
-> result
, gdb_stdout
);
282 gdbtk_fputs ("\n", gdb_stdout
);
288 gdbtk_readline_end ()
290 Tcl_Eval (interp
, "gdbtk_tcl_readline_end");
295 #ifdef ANSI_PROTOTYPES
296 dsprintf_append_element (Tcl_DString
*dsp
, char *format
, ...)
298 dsprintf_append_element (va_alist
)
305 #ifdef ANSI_PROTOTYPES
306 va_start (args
, format
);
312 dsp
= va_arg (args
, Tcl_DString
*);
313 format
= va_arg (args
, char *);
316 vsprintf (buf
, format
, args
);
318 Tcl_DStringAppendElement (dsp
, buf
);
322 gdb_path_conv (clientData
, interp
, argc
, argv
)
323 ClientData clientData
;
329 char pathname
[256], *ptr
;
331 error ("wrong # args");
332 cygwin32_conv_to_full_win32_path (argv
[1], pathname
);
333 for (ptr
= pathname
; *ptr
; ptr
++)
339 char *pathname
= argv
[1];
341 Tcl_DStringAppend (result_ptr
, pathname
, strlen(pathname
));
346 gdb_get_breakpoint_list (clientData
, interp
, argc
, argv
)
347 ClientData clientData
;
352 struct breakpoint
*b
;
353 extern struct breakpoint
*breakpoint_chain
;
356 error ("wrong # args");
358 for (b
= breakpoint_chain
; b
; b
= b
->next
)
359 if (b
->type
== bp_breakpoint
)
360 dsprintf_append_element (result_ptr
, "%d", b
->number
);
366 gdb_get_breakpoint_info (clientData
, interp
, argc
, argv
)
367 ClientData clientData
;
372 struct symtab_and_line sal
;
373 static char *bptypes
[] = {"breakpoint", "hardware breakpoint", "until",
374 "finish", "watchpoint", "hardware watchpoint",
375 "read watchpoint", "access watchpoint",
376 "longjmp", "longjmp resume", "step resume",
377 "through sigtramp", "watchpoint scope",
379 static char *bpdisp
[] = {"delete", "disable", "donttouch"};
380 struct command_line
*cmd
;
382 struct breakpoint
*b
;
383 extern struct breakpoint
*breakpoint_chain
;
386 error ("wrong # args");
388 bpnum
= atoi (argv
[1]);
390 for (b
= breakpoint_chain
; b
; b
= b
->next
)
391 if (b
->number
== bpnum
)
394 if (!b
|| b
->type
!= bp_breakpoint
)
395 error ("Breakpoint #%d does not exist", bpnum
);
397 sal
= find_pc_line (b
->address
, 0);
399 Tcl_DStringAppendElement (result_ptr
, symtab_to_filename (sal
.symtab
));
400 dsprintf_append_element (result_ptr
, "%d", sal
.line
);
401 dsprintf_append_element (result_ptr
, "0x%lx", b
->address
);
402 Tcl_DStringAppendElement (result_ptr
, bptypes
[b
->type
]);
403 Tcl_DStringAppendElement (result_ptr
, b
->enable
== enabled
? "1" : "0");
404 Tcl_DStringAppendElement (result_ptr
, bpdisp
[b
->disposition
]);
405 dsprintf_append_element (result_ptr
, "%d", b
->silent
);
406 dsprintf_append_element (result_ptr
, "%d", b
->ignore_count
);
408 Tcl_DStringStartSublist (result_ptr
);
409 for (cmd
= b
->commands
; cmd
; cmd
= cmd
->next
)
410 Tcl_DStringAppendElement (result_ptr
, cmd
->line
);
411 Tcl_DStringEndSublist (result_ptr
);
413 Tcl_DStringAppendElement (result_ptr
, b
->cond_string
);
415 dsprintf_append_element (result_ptr
, "%d", b
->thread
);
416 dsprintf_append_element (result_ptr
, "%d", b
->hit_count
);
422 breakpoint_notify(b
, action
)
423 struct breakpoint
*b
;
429 if (b
->type
!= bp_breakpoint
)
432 /* We ensure that ACTION contains no special Tcl characters, so we
434 sprintf (buf
, "gdbtk_tcl_breakpoint %s %d", action
, b
->number
);
436 v
= Tcl_Eval (interp
, buf
);
440 gdbtk_fputs (interp
->result
, gdb_stdout
);
441 gdbtk_fputs ("\n", gdb_stdout
);
446 gdbtk_create_breakpoint(b
)
447 struct breakpoint
*b
;
449 breakpoint_notify (b
, "create");
453 gdbtk_delete_breakpoint(b
)
454 struct breakpoint
*b
;
456 breakpoint_notify (b
, "delete");
460 gdbtk_modify_breakpoint(b
)
461 struct breakpoint
*b
;
463 breakpoint_notify (b
, "modify");
466 /* This implements the TCL command `gdb_loc', which returns a list consisting
467 of the source and line number associated with the current pc. */
470 gdb_loc (clientData
, interp
, argc
, argv
)
471 ClientData clientData
;
477 struct symtab_and_line sal
;
483 pc
= selected_frame
? selected_frame
->pc
: stop_pc
;
484 sal
= find_pc_line (pc
, 0);
488 struct symtabs_and_lines sals
;
491 sals
= decode_line_spec (argv
[1], 1);
498 error ("Ambiguous line spec");
503 error ("wrong # args");
506 Tcl_DStringAppendElement (result_ptr
, sal
.symtab
->filename
);
508 Tcl_DStringAppendElement (result_ptr
, "");
510 find_pc_partial_function (pc
, &funcname
, NULL
, NULL
);
511 Tcl_DStringAppendElement (result_ptr
, funcname
);
513 filename
= symtab_to_filename (sal
.symtab
);
514 Tcl_DStringAppendElement (result_ptr
, filename
);
516 dsprintf_append_element (result_ptr
, "%d", sal
.line
); /* line number */
518 dsprintf_append_element (result_ptr
, "0x%s", paddr_nz(pc
)); /* PC */
523 /* This implements the TCL command `gdb_eval'. */
526 gdb_eval (clientData
, interp
, argc
, argv
)
527 ClientData clientData
;
532 struct expression
*expr
;
533 struct cleanup
*old_chain
;
537 error ("wrong # args");
539 expr
= parse_expression (argv
[1]);
541 old_chain
= make_cleanup (free_current_contents
, &expr
);
543 val
= evaluate_expression (expr
);
545 val_print (VALUE_TYPE (val
), VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
546 gdb_stdout
, 0, 0, 0, 0);
548 do_cleanups (old_chain
);
553 /* This implements the TCL command `gdb_sourcelines', which returns a list of
554 all of the lines containing executable code for the specified source file
555 (ie: lines where you can put breakpoints). */
558 gdb_sourcelines (clientData
, interp
, argc
, argv
)
559 ClientData clientData
;
564 struct symtab
*symtab
;
565 struct linetable_entry
*le
;
569 error ("wrong # args");
571 symtab
= lookup_symtab (argv
[1]);
574 error ("No such file");
576 /* If there's no linetable, or no entries, then we are done. */
578 if (!symtab
->linetable
579 || symtab
->linetable
->nitems
== 0)
581 Tcl_DStringAppendElement (result_ptr
, "");
585 le
= symtab
->linetable
->item
;
586 nlines
= symtab
->linetable
->nitems
;
588 for (;nlines
> 0; nlines
--, le
++)
590 /* If the pc of this line is the same as the pc of the next line, then
593 && le
->pc
== (le
+ 1)->pc
)
596 dsprintf_append_element (result_ptr
, "%d", le
->line
);
603 map_arg_registers (argc
, argv
, func
, argp
)
606 void (*func
) PARAMS ((int regnum
, void *argp
));
611 /* Note that the test for a valid register must include checking the
612 reg_names array because NUM_REGS may be allocated for the union of the
613 register sets within a family of related processors. In this case, the
614 trailing entries of reg_names will change depending upon the particular
615 processor being debugged. */
617 if (argc
== 0) /* No args, just do all the regs */
621 && reg_names
[regnum
] != NULL
622 && *reg_names
[regnum
] != '\000';
629 /* Else, list of register #s, just do listed regs */
630 for (; argc
> 0; argc
--, argv
++)
632 regnum
= atoi (*argv
);
636 && reg_names
[regnum
] != NULL
637 && *reg_names
[regnum
] != '\000')
640 error ("bad register number");
647 get_register_name (regnum
, argp
)
649 void *argp
; /* Ignored */
651 Tcl_DStringAppendElement (result_ptr
, reg_names
[regnum
]);
654 /* This implements the TCL command `gdb_regnames', which returns a list of
655 all of the register names. */
658 gdb_regnames (clientData
, interp
, argc
, argv
)
659 ClientData clientData
;
667 return map_arg_registers (argc
, argv
, get_register_name
, NULL
);
670 #ifndef REGISTER_CONVERTIBLE
671 #define REGISTER_CONVERTIBLE(x) (0 != 0)
674 #ifndef REGISTER_CONVERT_TO_VIRTUAL
675 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
678 #ifndef INVALID_FLOAT
679 #define INVALID_FLOAT(x, y) (0 != 0)
683 get_register (regnum
, fp
)
687 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
688 char virtual_buffer
[MAX_REGISTER_VIRTUAL_SIZE
];
689 int format
= (int)fp
;
691 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
693 Tcl_DStringAppendElement (result_ptr
, "Optimized out");
697 /* Convert raw data to virtual format if necessary. */
699 if (REGISTER_CONVERTIBLE (regnum
))
701 REGISTER_CONVERT_TO_VIRTUAL (regnum
, REGISTER_VIRTUAL_TYPE (regnum
),
702 raw_buffer
, virtual_buffer
);
705 memcpy (virtual_buffer
, raw_buffer
, REGISTER_VIRTUAL_SIZE (regnum
));
710 printf_filtered ("0x");
711 for (j
= 0; j
< REGISTER_RAW_SIZE (regnum
); j
++)
713 register int idx
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? j
714 : REGISTER_RAW_SIZE (regnum
) - 1 - j
;
715 printf_filtered ("%02x", (unsigned char)raw_buffer
[idx
]);
719 val_print (REGISTER_VIRTUAL_TYPE (regnum
), virtual_buffer
, 0,
720 gdb_stdout
, format
, 1, 0, Val_pretty_default
);
722 Tcl_DStringAppend (result_ptr
, " ", -1);
726 gdb_fetch_registers (clientData
, interp
, argc
, argv
)
727 ClientData clientData
;
735 error ("wrong # args");
743 return map_arg_registers (argc
, argv
, get_register
, (void *) format
);
746 /* This contains the previous values of the registers, since the last call to
747 gdb_changed_register_list. */
749 static char old_regs
[REGISTER_BYTES
];
752 register_changed_p (regnum
, argp
)
754 void *argp
; /* Ignored */
756 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
758 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
761 if (memcmp (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
762 REGISTER_RAW_SIZE (regnum
)) == 0)
765 /* Found a changed register. Save new value and return its number. */
767 memcpy (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
768 REGISTER_RAW_SIZE (regnum
));
770 dsprintf_append_element (result_ptr
, "%d", regnum
);
774 gdb_changed_register_list (clientData
, interp
, argc
, argv
)
775 ClientData clientData
;
783 return map_arg_registers (argc
, argv
, register_changed_p
, NULL
);
786 /* This implements the TCL command `gdb_cmd', which sends its argument into
787 the GDB command scanner. */
790 gdb_cmd (clientData
, interp
, argc
, argv
)
791 ClientData clientData
;
797 error ("wrong # args");
802 execute_command (argv
[1], 1);
804 bpstat_do_actions (&stop_bpstat
);
809 /* This routine acts as a top-level for all GDB code called by tcl/Tk. It
810 handles cleanups, and calls to return_to_top_level (usually via error).
811 This is necessary in order to prevent a longjmp out of the bowels of Tk,
812 possibly leaving things in a bad state. Since this routine can be called
813 recursively, it needs to save and restore the contents of the jmp_buf as
817 call_wrapper (clientData
, interp
, argc
, argv
)
818 ClientData clientData
;
824 struct cleanup
*saved_cleanup_chain
;
826 jmp_buf saved_error_return
;
827 Tcl_DString result
, *old_result_ptr
;
829 Tcl_DStringInit (&result
);
830 old_result_ptr
= result_ptr
;
831 result_ptr
= &result
;
833 func
= (Tcl_CmdProc
*)clientData
;
834 memcpy (saved_error_return
, error_return
, sizeof (jmp_buf));
836 saved_cleanup_chain
= save_cleanups ();
838 if (!setjmp (error_return
))
839 val
= func (clientData
, interp
, argc
, argv
);
842 val
= TCL_ERROR
; /* Flag an error for TCL */
844 gdb_flush (gdb_stderr
); /* Flush error output */
846 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
848 /* In case of an error, we may need to force the GUI into idle
849 mode because gdbtk_call_command may have bombed out while in
850 the command routine. */
853 Tcl_Eval (interp
, "gdbtk_tcl_idle");
856 do_cleanups (ALL_CLEANUPS
);
858 restore_cleanups (saved_cleanup_chain
);
860 memcpy (error_return
, saved_error_return
, sizeof (jmp_buf));
862 Tcl_DStringResult (interp
, &result
);
863 result_ptr
= old_result_ptr
;
869 gdb_listfiles (clientData
, interp
, argc
, argv
)
870 ClientData clientData
;
875 struct objfile
*objfile
;
876 struct partial_symtab
*psymtab
;
877 struct symtab
*symtab
;
879 ALL_PSYMTABS (objfile
, psymtab
)
880 Tcl_DStringAppendElement (result_ptr
, psymtab
->filename
);
882 ALL_SYMTABS (objfile
, symtab
)
883 Tcl_DStringAppendElement (result_ptr
, symtab
->filename
);
889 gdb_stop (clientData
, interp
, argc
, argv
)
890 ClientData clientData
;
900 /* This implements the TCL command `gdb_disassemble'. */
903 gdbtk_dis_asm_read_memory (memaddr
, myaddr
, len
, info
)
907 disassemble_info
*info
;
909 extern struct target_ops exec_ops
;
913 res
= xfer_memory (memaddr
, myaddr
, len
, 0, &exec_ops
);
924 /* We need a different sort of line table from the normal one cuz we can't
925 depend upon implicit line-end pc's for lines. This is because of the
926 reordering we are about to do. */
928 struct my_line_entry
{
935 compare_lines (mle1p
, mle2p
)
939 struct my_line_entry
*mle1
, *mle2
;
942 mle1
= (struct my_line_entry
*) mle1p
;
943 mle2
= (struct my_line_entry
*) mle2p
;
945 val
= mle1
->line
- mle2
->line
;
950 return mle1
->start_pc
- mle2
->start_pc
;
954 gdb_disassemble (clientData
, interp
, argc
, argv
)
955 ClientData clientData
;
960 CORE_ADDR pc
, low
, high
;
961 int mixed_source_and_assembly
;
962 static disassemble_info di
;
963 static int di_initialized
;
965 if (! di_initialized
)
967 INIT_DISASSEMBLE_INFO_NO_ARCH (di
, gdb_stdout
,
968 (fprintf_ftype
) fprintf_unfiltered
);
969 di
.flavour
= bfd_target_unknown_flavour
;
970 di
.memory_error_func
= dis_asm_memory_error
;
971 di
.print_address_func
= dis_asm_print_address
;
975 di
.mach
= tm_print_insn_info
.mach
;
976 if (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
977 tm_print_insn_info
.endian
= BFD_ENDIAN_BIG
;
979 tm_print_insn_info
.endian
= BFD_ENDIAN_LITTLE
;
981 if (argc
!= 3 && argc
!= 4)
982 error ("wrong # args");
984 if (strcmp (argv
[1], "source") == 0)
985 mixed_source_and_assembly
= 1;
986 else if (strcmp (argv
[1], "nosource") == 0)
987 mixed_source_and_assembly
= 0;
989 error ("First arg must be 'source' or 'nosource'");
991 low
= parse_and_eval_address (argv
[2]);
995 if (find_pc_partial_function (low
, NULL
, &low
, &high
) == 0)
996 error ("No function contains specified address");
999 high
= parse_and_eval_address (argv
[3]);
1001 /* If disassemble_from_exec == -1, then we use the following heuristic to
1002 determine whether or not to do disassembly from target memory or from the
1005 If we're debugging a local process, read target memory, instead of the
1006 exec file. This makes disassembly of functions in shared libs work
1009 Else, we're debugging a remote process, and should disassemble from the
1010 exec file for speed. However, this is no good if the target modifies its
1011 code (for relocation, or whatever).
1014 if (disassemble_from_exec
== -1)
1015 if (strcmp (target_shortname
, "child") == 0
1016 || strcmp (target_shortname
, "procfs") == 0
1017 || strcmp (target_shortname
, "vxprocess") == 0)
1018 disassemble_from_exec
= 0; /* It's a child process, read inferior mem */
1020 disassemble_from_exec
= 1; /* It's remote, read the exec file */
1022 if (disassemble_from_exec
)
1023 di
.read_memory_func
= gdbtk_dis_asm_read_memory
;
1025 di
.read_memory_func
= dis_asm_read_memory
;
1027 /* If just doing straight assembly, all we need to do is disassemble
1028 everything between low and high. If doing mixed source/assembly, we've
1029 got a totally different path to follow. */
1031 if (mixed_source_and_assembly
)
1032 { /* Come here for mixed source/assembly */
1033 /* The idea here is to present a source-O-centric view of a function to
1034 the user. This means that things are presented in source order, with
1035 (possibly) out of order assembly immediately following. */
1036 struct symtab
*symtab
;
1037 struct linetable_entry
*le
;
1040 struct my_line_entry
*mle
;
1041 struct symtab_and_line sal
;
1046 symtab
= find_pc_symtab (low
); /* Assume symtab is valid for whole PC range */
1051 /* First, convert the linetable to a bunch of my_line_entry's. */
1053 le
= symtab
->linetable
->item
;
1054 nlines
= symtab
->linetable
->nitems
;
1059 mle
= (struct my_line_entry
*) alloca (nlines
* sizeof (struct my_line_entry
));
1063 /* Copy linetable entries for this function into our data structure, creating
1064 end_pc's and setting out_of_order as appropriate. */
1066 /* First, skip all the preceding functions. */
1068 for (i
= 0; i
< nlines
- 1 && le
[i
].pc
< low
; i
++) ;
1070 /* Now, copy all entries before the end of this function. */
1073 for (; i
< nlines
- 1 && le
[i
].pc
< high
; i
++)
1075 if (le
[i
].line
== le
[i
+ 1].line
1076 && le
[i
].pc
== le
[i
+ 1].pc
)
1077 continue; /* Ignore duplicates */
1079 mle
[newlines
].line
= le
[i
].line
;
1080 if (le
[i
].line
> le
[i
+ 1].line
)
1082 mle
[newlines
].start_pc
= le
[i
].pc
;
1083 mle
[newlines
].end_pc
= le
[i
+ 1].pc
;
1087 /* If we're on the last line, and it's part of the function, then we need to
1088 get the end pc in a special way. */
1093 mle
[newlines
].line
= le
[i
].line
;
1094 mle
[newlines
].start_pc
= le
[i
].pc
;
1095 sal
= find_pc_line (le
[i
].pc
, 0);
1096 mle
[newlines
].end_pc
= sal
.end
;
1100 /* Now, sort mle by line #s (and, then by addresses within lines). */
1103 qsort (mle
, newlines
, sizeof (struct my_line_entry
), compare_lines
);
1105 /* Now, for each line entry, emit the specified lines (unless they have been
1106 emitted before), followed by the assembly code for that line. */
1108 next_line
= 0; /* Force out first line */
1109 for (i
= 0; i
< newlines
; i
++)
1111 /* Print out everything from next_line to the current line. */
1113 if (mle
[i
].line
>= next_line
)
1116 print_source_lines (symtab
, next_line
, mle
[i
].line
+ 1, 0);
1118 print_source_lines (symtab
, mle
[i
].line
, mle
[i
].line
+ 1, 0);
1120 next_line
= mle
[i
].line
+ 1;
1123 for (pc
= mle
[i
].start_pc
; pc
< mle
[i
].end_pc
; )
1126 fputs_unfiltered (" ", gdb_stdout
);
1127 print_address (pc
, gdb_stdout
);
1128 fputs_unfiltered (":\t ", gdb_stdout
);
1129 pc
+= (*tm_print_insn
) (pc
, &di
);
1130 fputs_unfiltered ("\n", gdb_stdout
);
1137 for (pc
= low
; pc
< high
; )
1140 fputs_unfiltered (" ", gdb_stdout
);
1141 print_address (pc
, gdb_stdout
);
1142 fputs_unfiltered (":\t ", gdb_stdout
);
1143 pc
+= (*tm_print_insn
) (pc
, &di
);
1144 fputs_unfiltered ("\n", gdb_stdout
);
1148 gdb_flush (gdb_stdout
);
1154 tk_command (cmd
, from_tty
)
1160 struct cleanup
*old_chain
;
1162 /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1164 error_no_arg ("tcl command to interpret");
1166 retval
= Tcl_Eval (interp
, cmd
);
1168 result
= strdup (interp
->result
);
1170 old_chain
= make_cleanup (free
, result
);
1172 if (retval
!= TCL_OK
)
1175 printf_unfiltered ("%s\n", result
);
1177 do_cleanups (old_chain
);
1181 cleanup_init (ignored
)
1185 Tcl_DeleteInterp (interp
);
1189 /* Come here during long calculations to check for GUI events. Usually invoked
1190 via the QUIT macro. */
1193 gdbtk_interactive ()
1195 /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1198 /* Come here when there is activity on the X file descriptor. */
1204 /* Process pending events */
1206 while (Tcl_DoOneEvent (TCL_DONT_WAIT
|TCL_ALL_EVENTS
) != 0);
1210 gdbtk_wait (pid
, ourstatus
)
1212 struct target_waitstatus
*ourstatus
;
1214 struct sigaction action
;
1215 static sigset_t nullsigmask
= {0};
1218 /* Needed for SunOS 4.1.x */
1219 #define SA_RESTART 0
1222 action
.sa_handler
= x_event
;
1223 action
.sa_mask
= nullsigmask
;
1224 action
.sa_flags
= SA_RESTART
;
1226 sigaction(SIGIO
, &action
, NULL
);
1229 pid
= target_wait (pid
, ourstatus
);
1231 action
.sa_handler
= SIG_IGN
;
1233 sigaction(SIGIO
, &action
, NULL
);
1239 /* This is called from execute_command, and provides a wrapper around
1240 various command routines in a place where both protocol messages and
1241 user input both flow through. Mostly this is used for indicating whether
1242 the target process is running or not.
1246 gdbtk_call_command (cmdblk
, arg
, from_tty
)
1247 struct cmd_list_element
*cmdblk
;
1252 if (cmdblk
->class == class_run
)
1255 Tcl_Eval (interp
, "gdbtk_tcl_busy");
1256 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
1257 Tcl_Eval (interp
, "gdbtk_tcl_idle");
1261 (*cmdblk
->function
.cfunc
)(arg
, from_tty
);
1264 /* This function is called instead of gdb's internal command loop. This is the
1265 last chance to do anything before entering the main Tk event loop. */
1270 extern GDB_FILE
*instream
;
1272 /* We no longer want to use stdin as the command input stream */
1274 Tcl_Eval (interp
, "gdbtk_tcl_preloop");
1281 struct cleanup
*old_chain
;
1282 char *lib
, *gdbtk_lib
, gdbtk_lib_tmp
[1024],gdbtk_file
[128];
1284 struct sigaction action
;
1285 static sigset_t nullsigmask
= {0};
1287 /* If there is no DISPLAY environment variable, Tk_Init below will fail,
1288 causing gdb to abort. If instead we simply return here, gdb will
1289 gracefully degrade to using the command line interface. */
1292 if (getenv ("DISPLAY") == NULL
)
1296 old_chain
= make_cleanup (cleanup_init
, 0);
1298 /* First init tcl and tk. */
1300 interp
= Tcl_CreateInterp ();
1303 error ("Tcl_CreateInterp failed");
1305 if (Tcl_Init(interp
) != TCL_OK
)
1306 error ("Tcl_Init failed: %s", interp
->result
);
1309 if (Itcl_Init(interp) == TCL_ERROR)
1310 error ("Itcl_Init failed: %s", interp->result);
1313 if (Tk_Init(interp
) != TCL_OK
)
1314 error ("Tk_Init failed: %s", interp
->result
);
1316 Tcl_CreateCommand (interp
, "gdb_cmd", call_wrapper
, gdb_cmd
, NULL
);
1317 Tcl_CreateCommand (interp
, "gdb_loc", call_wrapper
, gdb_loc
, NULL
);
1318 Tcl_CreateCommand (interp
, "gdb_path_conv", call_wrapper
, gdb_path_conv
, NULL
);
1319 Tcl_CreateCommand (interp
, "gdb_sourcelines", call_wrapper
, gdb_sourcelines
,
1321 Tcl_CreateCommand (interp
, "gdb_listfiles", call_wrapper
, gdb_listfiles
,
1323 Tcl_CreateCommand (interp
, "gdb_stop", call_wrapper
, gdb_stop
, NULL
);
1324 Tcl_CreateCommand (interp
, "gdb_regnames", call_wrapper
, gdb_regnames
, NULL
);
1325 Tcl_CreateCommand (interp
, "gdb_fetch_registers", call_wrapper
,
1326 gdb_fetch_registers
, NULL
);
1327 Tcl_CreateCommand (interp
, "gdb_changed_register_list", call_wrapper
,
1328 gdb_changed_register_list
, NULL
);
1329 Tcl_CreateCommand (interp
, "gdb_disassemble", call_wrapper
,
1330 gdb_disassemble
, NULL
);
1331 Tcl_CreateCommand (interp
, "gdb_eval", call_wrapper
, gdb_eval
, NULL
);
1332 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_list", call_wrapper
,
1333 gdb_get_breakpoint_list
, NULL
);
1334 Tcl_CreateCommand (interp
, "gdb_get_breakpoint_info", call_wrapper
,
1335 gdb_get_breakpoint_info
, NULL
);
1337 command_loop_hook
= tk_command_loop
;
1338 print_frame_info_listing_hook
=
1339 (void (*) PARAMS ((struct symtab
*, int, int, int))) null_routine
;
1340 query_hook
= gdbtk_query
;
1341 flush_hook
= gdbtk_flush
;
1342 create_breakpoint_hook
= gdbtk_create_breakpoint
;
1343 delete_breakpoint_hook
= gdbtk_delete_breakpoint
;
1344 modify_breakpoint_hook
= gdbtk_modify_breakpoint
;
1345 interactive_hook
= gdbtk_interactive
;
1346 target_wait_hook
= gdbtk_wait
;
1347 call_command_hook
= gdbtk_call_command
;
1348 readline_begin_hook
= gdbtk_readline_begin
;
1349 readline_hook
= gdbtk_readline
;
1350 readline_end_hook
= gdbtk_readline_end
;
1352 /* Get the file descriptor for the X server */
1354 x_fd
= ConnectionNumber (Tk_Display (Tk_MainWindow (interp
)));
1356 /* Setup for I/O interrupts */
1358 action
.sa_mask
= nullsigmask
;
1359 action
.sa_flags
= 0;
1360 action
.sa_handler
= SIG_IGN
;
1362 sigaction(SIGIO
, &action
, NULL
);
1367 if (ioctl (x_fd
, FIOASYNC
, &i
))
1368 perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
1372 if (ioctl (x_fd
, SIOCSPGRP
, &i
))
1373 perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
1378 if (fcntl (x_fd
, F_SETOWN
, i
))
1379 perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
1380 #endif /* F_SETOWN */
1381 #endif /* !SIOCSPGRP */
1384 if (ioctl (x_fd
, I_SETSIG
, S_INPUT
|S_RDNORM
) < 0)
1385 perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
1388 #endif /* ifndef FIOASYNC */
1390 add_com ("tk", class_obscure
, tk_command
,
1391 "Send a command directly into tk.");
1393 Tcl_LinkVar (interp
, "disassemble-from-exec", (char *)&disassemble_from_exec
,
1396 /* find the gdb tcl library and source main.tcl */
1398 gdbtk_lib
= getenv ("GDBTK_LIBRARY");
1400 if (access ("gdbtcl/main.tcl", R_OK
) == 0)
1401 gdbtk_lib
= "gdbtcl";
1403 gdbtk_lib
= GDBTK_LIBRARY
;
1405 strcpy (gdbtk_lib_tmp
, gdbtk_lib
);
1407 /* see if GDBTK_LIBRARY is a path list */
1408 lib
= strtok (gdbtk_lib_tmp
, GDBTK_PATH_SEP
);
1411 if (Tcl_VarEval (interp
, "lappend auto_path ", lib
, NULL
) != TCL_OK
)
1413 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
1418 strcpy (gdbtk_file
, lib
);
1419 strcat (gdbtk_file
, "/main.tcl");
1420 if (access (gdbtk_file
, R_OK
) == 0)
1423 Tcl_SetVar (interp
, "GDBTK_LIBRARY", lib
, 0);
1427 while (lib
= strtok (NULL
, ":"));
1431 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
1432 if (getenv("GDBTK_LIBRARY"))
1434 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
1435 fprintf_unfiltered (stderr
,
1436 "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
1440 fprintf_unfiltered (stderr
, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY
);
1441 fprintf_unfiltered (stderr
, "You might want to set GDBTK_LIBRARY\n");
1446 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
1447 prior to this point go to stdout/stderr. */
1449 fputs_unfiltered_hook
= gdbtk_fputs
;
1451 if (Tcl_EvalFile (interp
, gdbtk_file
) != TCL_OK
)
1453 fputs_unfiltered_hook
= NULL
; /* Force errors to stdout/stderr */
1455 fprintf_unfiltered (stderr
, "%s:%d: %s\n", gdbtk_file
,
1456 interp
->errorLine
, interp
->result
);
1458 fputs_unfiltered ("Stack trace:\n", gdb_stderr
);
1459 fputs_unfiltered (Tcl_GetVar (interp
, "errorInfo", 0), gdb_stderr
);
1463 discard_cleanups (old_chain
);
1466 /* Come here during initialize_all_files () */
1469 _initialize_gdbtk ()
1473 /* Tell the rest of the world that Gdbtk is now set up. */
1475 init_ui_hook
= gdbtk_init
;