1 /* Tcl/Tk command definitions for gdbtk.
2 Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
4 Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
31 #include "tracepoint.h"
48 /* start-sanitize-ide */
52 /* end-sanitize-ide */
55 #ifdef ANSI_PROTOTYPES
65 #include <sys/ioctl.h>
66 #include "gdb_string.h"
74 /* This structure filled in call_wrapper and passed to
75 the wrapped call function.
76 It stores the command pointer and arguments
77 run in the wrapper function. */
79 struct wrapped_call_args
88 /* These two objects hold boolean true and false,
89 and are shared by all the list objects that gdb_listfuncs
92 static Tcl_Obj
*mangled
, *not_mangled
;
94 /* These two control how the GUI behaves when gdb is either tracing or loading.
95 They are used in this file & gdbtk_hooks.c */
98 int load_in_progress
= 0;
101 * This is used in the register fetching routines
104 #ifndef REGISTER_CONVERTIBLE
105 #define REGISTER_CONVERTIBLE(x) (0 != 0)
108 #ifndef REGISTER_CONVERT_TO_VIRTUAL
109 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
112 #ifndef INVALID_FLOAT
113 #define INVALID_FLOAT(x, y) (0 != 0)
118 /* This Structure is used in gdb_disassemble.
119 We need a different sort of line table from the normal one cuz we can't
120 depend upon implicit line-end pc's for lines to do the
121 reordering in this function. */
123 struct my_line_entry
{
129 /* This contains the previous values of the registers, since the last call to
130 gdb_changed_register_list. */
132 static char old_regs
[REGISTER_BYTES
];
135 * These are routines we need from breakpoint.c.
136 * at some point make these static in breakpoint.c and move GUI code there
139 extern struct breakpoint
*set_raw_breakpoint (struct symtab_and_line sal
);
140 extern void set_breakpoint_count (int);
141 extern int breakpoint_count
;
145 * Declarations for routines exported from this file
148 int Gdbtk_Init (Tcl_Interp
*interp
);
151 * Declarations for routines used only in this file.
154 static int compare_lines
PARAMS ((const PTR
, const PTR
));
155 static int comp_files
PARAMS ((const void *, const void *));
156 static int call_wrapper
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
157 static int gdb_actions_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
158 Tcl_Obj
*CONST objv
[]));
159 static int gdb_changed_register_list
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
160 static int gdb_clear_file
PARAMS ((ClientData
, Tcl_Interp
*interp
, int, Tcl_Obj
*CONST
[]));
161 static int gdb_cmd
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
162 static int gdb_confirm_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
163 static int gdb_disassemble
PARAMS ((ClientData
, Tcl_Interp
*, int,
165 static int gdb_eval
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
166 static int gdb_fetch_registers
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
167 static int gdb_find_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
168 Tcl_Obj
*CONST objv
[]));
169 static int gdb_force_quit
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
170 static struct symtab
*full_lookup_symtab
PARAMS ((char *file
));
171 static int gdb_get_args_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
172 Tcl_Obj
*CONST objv
[]));
173 static int gdb_get_breakpoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
174 static int gdb_get_breakpoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
175 static int gdb_get_file_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
176 Tcl_Obj
*CONST objv
[]));
177 static int gdb_get_function_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
178 Tcl_Obj
*CONST objv
[]));
179 static int gdb_get_line_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
180 Tcl_Obj
*CONST objv
[]));
181 static int gdb_get_locals_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
182 Tcl_Obj
*CONST objv
[]));
183 static int gdb_get_mem
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
184 static int gdb_get_trace_frame_num
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
185 static int gdb_get_tracepoint_list
PARAMS ((ClientData
, Tcl_Interp
*, int,
186 Tcl_Obj
*CONST objv
[]));
187 static int gdb_get_vars_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
188 Tcl_Obj
*CONST objv
[]));
189 static int gdb_immediate_command
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
190 static int gdb_listfiles
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
191 static int gdb_listfuncs
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
192 static int gdb_loadfile
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
193 static int gdb_load_info
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
194 static int gdb_loc
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
195 static int gdb_path_conv
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
196 static int gdb_prompt_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
197 Tcl_Obj
*CONST objv
[]));
198 static int gdb_regnames
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
199 static int gdb_search
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
201 static int gdb_set_bp
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
202 static int gdb_set_bp_addr
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
203 static int gdb_find_bp_at_line
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
204 static int gdb_find_bp_at_addr
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST objv
[]));
205 static int gdb_stop
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
206 static int gdb_target_has_execution_command
PARAMS ((ClientData
, Tcl_Interp
*,
209 static int gdb_trace_status
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
210 static int gdb_tracepoint_exists_command
PARAMS ((ClientData
, Tcl_Interp
*,
212 Tcl_Obj
*CONST objv
[]));
213 static int gdb_get_tracepoint_info
PARAMS ((ClientData
, Tcl_Interp
*, int,
214 Tcl_Obj
*CONST objv
[]));
215 static int gdbtk_dis_asm_read_memory
PARAMS ((bfd_vma
, bfd_byte
*, int, disassemble_info
*));
216 static int get_pc_register
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
217 static int gdb_stack
PARAMS ((ClientData
, Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
219 char * get_prompt
PARAMS ((void));
220 static void get_register
PARAMS ((int, void *));
221 static void get_register_name
PARAMS ((int, void *));
222 static int map_arg_registers
PARAMS ((int, Tcl_Obj
*CONST
[], void (*) (int, void *), void *));
223 static int perror_with_name_wrapper
PARAMS ((char *args
));
224 static void register_changed_p
PARAMS ((int, void *));
225 void TclDebug
PARAMS ((const char *fmt
, ...));
226 static int wrapped_call (char *opaque_args
);
227 static void get_frame_name
PARAMS ((Tcl_Interp
*interp
, Tcl_Obj
*list
, struct frame_info
*fi
));
230 * This loads all the Tcl commands into the Tcl interpreter.
233 * interp - The interpreter into which to load the commands.
236 * A standard Tcl result.
243 Tcl_CreateObjCommand (interp
, "gdb_cmd", call_wrapper
, gdb_cmd
, NULL
);
244 Tcl_CreateObjCommand (interp
, "gdb_immediate", call_wrapper
,
245 gdb_immediate_command
, NULL
);
246 Tcl_CreateObjCommand (interp
, "gdb_loc", call_wrapper
, gdb_loc
, NULL
);
247 Tcl_CreateObjCommand (interp
, "gdb_path_conv", call_wrapper
, gdb_path_conv
, NULL
);
248 Tcl_CreateObjCommand (interp
, "gdb_listfiles", call_wrapper
, gdb_listfiles
, NULL
);
249 Tcl_CreateObjCommand (interp
, "gdb_listfuncs", call_wrapper
, gdb_listfuncs
,
251 Tcl_CreateObjCommand (interp
, "gdb_get_mem", call_wrapper
, gdb_get_mem
,
253 Tcl_CreateObjCommand (interp
, "gdb_stop", call_wrapper
, gdb_stop
, NULL
);
254 Tcl_CreateObjCommand (interp
, "gdb_regnames", call_wrapper
, gdb_regnames
, NULL
);
255 Tcl_CreateObjCommand (interp
, "gdb_fetch_registers", call_wrapper
,
256 gdb_fetch_registers
, NULL
);
257 Tcl_CreateObjCommand (interp
, "gdb_changed_register_list", call_wrapper
,
258 gdb_changed_register_list
, NULL
);
259 Tcl_CreateObjCommand (interp
, "gdb_disassemble", call_wrapper
,
260 gdb_disassemble
, NULL
);
261 Tcl_CreateObjCommand (interp
, "gdb_eval", call_wrapper
, gdb_eval
, NULL
);
262 Tcl_CreateObjCommand (interp
, "gdb_get_breakpoint_list", call_wrapper
,
263 gdb_get_breakpoint_list
, NULL
);
264 Tcl_CreateObjCommand (interp
, "gdb_get_breakpoint_info", call_wrapper
,
265 gdb_get_breakpoint_info
, NULL
);
266 Tcl_CreateObjCommand (interp
, "gdb_clear_file", call_wrapper
,
267 gdb_clear_file
, NULL
);
268 Tcl_CreateObjCommand (interp
, "gdb_confirm_quit", call_wrapper
,
269 gdb_confirm_quit
, NULL
);
270 Tcl_CreateObjCommand (interp
, "gdb_force_quit", call_wrapper
,
271 gdb_force_quit
, NULL
);
272 Tcl_CreateObjCommand (interp
, "gdb_target_has_execution",
274 gdb_target_has_execution_command
, NULL
);
275 Tcl_CreateObjCommand (interp
, "gdb_is_tracing",
276 call_wrapper
, gdb_trace_status
,
278 Tcl_CreateObjCommand (interp
, "gdb_load_info", call_wrapper
, gdb_load_info
, NULL
);
279 Tcl_CreateObjCommand (interp
, "gdb_get_locals", call_wrapper
, gdb_get_locals_command
,
281 Tcl_CreateObjCommand (interp
, "gdb_get_args", call_wrapper
, gdb_get_args_command
,
283 Tcl_CreateObjCommand (interp
, "gdb_get_function", call_wrapper
, gdb_get_function_command
,
285 Tcl_CreateObjCommand (interp
, "gdb_get_line", call_wrapper
, gdb_get_line_command
,
287 Tcl_CreateObjCommand (interp
, "gdb_get_file", call_wrapper
, gdb_get_file_command
,
289 Tcl_CreateObjCommand (interp
, "gdb_tracepoint_exists",
290 call_wrapper
, gdb_tracepoint_exists_command
, NULL
);
291 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_info",
292 call_wrapper
, gdb_get_tracepoint_info
, NULL
);
293 Tcl_CreateObjCommand (interp
, "gdb_actions",
294 call_wrapper
, gdb_actions_command
, NULL
);
295 Tcl_CreateObjCommand (interp
, "gdb_prompt",
296 call_wrapper
, gdb_prompt_command
, NULL
);
297 Tcl_CreateObjCommand (interp
, "gdb_find_file",
298 call_wrapper
, gdb_find_file_command
, NULL
);
299 Tcl_CreateObjCommand (interp
, "gdb_get_tracepoint_list",
300 call_wrapper
, gdb_get_tracepoint_list
, NULL
);
301 Tcl_CreateObjCommand (interp
, "gdb_pc_reg", call_wrapper
, get_pc_register
, NULL
);
302 Tcl_CreateObjCommand (interp
, "gdb_loadfile", call_wrapper
, gdb_loadfile
, NULL
);
303 Tcl_CreateObjCommand (gdbtk_interp
, "gdb_search", call_wrapper
,
305 Tcl_CreateObjCommand (interp
, "gdb_set_bp", call_wrapper
, gdb_set_bp
, NULL
);
306 Tcl_CreateObjCommand (interp
, "gdb_set_bp_addr", call_wrapper
, gdb_set_bp_addr
, NULL
);
307 Tcl_CreateObjCommand (interp
, "gdb_find_bp_at_line", call_wrapper
, gdb_find_bp_at_line
, NULL
);
308 Tcl_CreateObjCommand (interp
, "gdb_find_bp_at_addr", call_wrapper
, gdb_find_bp_at_addr
, NULL
);
309 Tcl_CreateObjCommand (interp
, "gdb_get_trace_frame_num",
310 call_wrapper
, gdb_get_trace_frame_num
, NULL
);
311 Tcl_CreateObjCommand (interp
, "gdb_stack", call_wrapper
, gdb_stack
, NULL
);
313 Tcl_LinkVar (interp
, "gdb_selected_frame_level",
314 (char *) &selected_frame_level
,
315 TCL_LINK_INT
| TCL_LINK_READ_ONLY
);
317 /* gdb_context is used for debugging multiple threads or tasks */
318 Tcl_LinkVar (interp
, "gdb_context_id",
319 (char *) &gdb_context
,
320 TCL_LINK_INT
| TCL_LINK_READ_ONLY
);
322 Tcl_PkgProvide(interp
, "Gdbtk", GDBTK_VERSION
);
326 /* This routine acts as a top-level for all GDB code called by Tcl/Tk. It
327 handles cleanups, and uses catch_errors to trap calls to return_to_top_level
329 This is necessary in order to prevent a longjmp out of the bowels of Tk,
330 possibly leaving things in a bad state. Since this routine can be called
331 recursively, it needs to save and restore the contents of the result_ptr as
335 call_wrapper (clientData
, interp
, objc
, objv
)
336 ClientData clientData
;
339 Tcl_Obj
*CONST objv
[];
341 struct wrapped_call_args wrapped_args
;
342 gdbtk_result new_result
, *old_result_ptr
;
344 old_result_ptr
= result_ptr
;
345 result_ptr
= &new_result
;
346 result_ptr
->obj_ptr
= Tcl_NewObj();
347 result_ptr
->flags
= GDBTK_TO_RESULT
;
349 wrapped_args
.func
= (Tcl_ObjCmdProc
*) clientData
;
350 wrapped_args
.interp
= interp
;
351 wrapped_args
.objc
= objc
;
352 wrapped_args
.objv
= objv
;
353 wrapped_args
.val
= TCL_OK
;
355 if (!catch_errors (wrapped_call
, &wrapped_args
, "", RETURN_MASK_ALL
))
358 wrapped_args
.val
= TCL_ERROR
; /* Flag an error for TCL */
360 /* Make sure the timer interrupts are turned off. */
364 gdb_flush (gdb_stderr
); /* Flush error output */
365 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
367 /* If we errored out here, and the results were going to the
368 console, then gdbtk_fputs will have gathered the result into the
369 result_ptr. We also need to echo them out to the console here */
371 gdb_flush (gdb_stderr
); /* Flush error output */
372 gdb_flush (gdb_stdout
); /* Sometimes error output comes here as well */
374 /* In case of an error, we may need to force the GUI into idle
375 mode because gdbtk_call_command may have bombed out while in
376 the command routine. */
379 Tcl_Eval (interp
, "gdbtk_tcl_idle");
383 /* do not suppress any errors -- a remote target could have errored */
384 load_in_progress
= 0;
387 * Now copy the result over to the true Tcl result. If GDBTK_TO_RESULT flag
388 * bit is set , this just copies a null object over to the Tcl result, which is
389 * fine because we should reset the result in this case anyway.
391 if (result_ptr
->flags
& GDBTK_IN_TCL_RESULT
)
393 Tcl_DecrRefCount(result_ptr
->obj_ptr
);
397 Tcl_SetObjResult (interp
, result_ptr
->obj_ptr
);
400 result_ptr
= old_result_ptr
;
406 return wrapped_args
.val
;
410 * This is the wrapper that is passed to catch_errors.
414 wrapped_call (opaque_args
)
417 struct wrapped_call_args
*args
= (struct wrapped_call_args
*) opaque_args
;
418 args
->val
= (*args
->func
) (args
->func
, args
->interp
, args
->objc
, args
->objv
);
422 /* This is a convenience function to sprintf something(s) into a
423 * new element in a Tcl list object.
427 #ifdef ANSI_PROTOTYPES
428 sprintf_append_element_to_obj (Tcl_Obj
*objp
, char *format
, ...)
430 sprintf_append_element_to_obj (va_alist
)
437 #ifdef ANSI_PROTOTYPES
438 va_start (args
, format
);
444 dsp
= va_arg (args
, Tcl_Obj
*);
445 format
= va_arg (args
, char *);
448 vsprintf (buf
, format
, args
);
450 Tcl_ListObjAppendElement (NULL
, objp
, Tcl_NewStringObj (buf
, -1));
454 * This section contains the commands that control execution.
457 /* This implements the tcl command gdb_clear_file.
459 * Prepare to accept a new executable file. This is called when we
460 * want to clear away everything we know about the old file, without
461 * asking the user. The Tcl code will have already asked the user if
462 * necessary. After this is called, we should be able to run the
463 * `file' command without getting any questions.
472 gdb_clear_file (clientData
, interp
, objc
, objv
)
473 ClientData clientData
;
476 Tcl_Obj
*CONST objv
[];
479 Tcl_SetStringObj (result_ptr
->obj_ptr
,
480 "Wrong number of args, none are allowed.", -1);
482 if (inferior_pid
!= 0 && target_has_execution
)
485 target_detach (NULL
, 0);
490 if (target_has_execution
)
493 symbol_file_command (NULL
, 0);
495 /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
496 clear it here. FIXME: This seems like an abstraction violation
503 /* This implements the tcl command gdb_confirm_quit
504 * Ask the user to confirm an exit request.
509 * A boolean, 1 if the user answered yes, 0 if no.
513 gdb_confirm_quit (clientData
, interp
, objc
, objv
)
514 ClientData clientData
;
517 Tcl_Obj
*CONST objv
[];
523 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Wrong number of args, should be none.", -1);
527 ret
= quit_confirm ();
528 Tcl_SetBooleanObj (result_ptr
->obj_ptr
, ret
);
532 /* This implements the tcl command gdb_force_quit
533 * Quit without asking for confirmation.
542 gdb_force_quit (clientData
, interp
, objc
, objv
)
543 ClientData clientData
;
546 Tcl_Obj
*CONST objv
[];
550 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Wrong number of args, should be none.", -1);
554 quit_force ((char *) NULL
, 1);
558 /* This implements the tcl command gdb_stop
559 * It stops the target in a continuable fashion.
568 gdb_stop (clientData
, interp
, objc
, objv
)
569 ClientData clientData
;
572 Tcl_Obj
*CONST objv
[];
574 if (target_stop
!= target_ignore
)
577 quit_flag
= 1; /* hope something sees this */
584 * This section contains Tcl commands that are wrappers for invoking
585 * the GDB command interpreter.
589 /* This implements the tcl command `gdb_eval'.
590 * It uses the gdb evaluator to return the value of
591 * an expression in the current language
594 * expression - the expression to evaluate.
596 * The result of the evaluation.
600 gdb_eval (clientData
, interp
, objc
, objv
)
601 ClientData clientData
;
604 Tcl_Obj
*CONST objv
[];
606 struct expression
*expr
;
607 struct cleanup
*old_chain
=NULL
;
612 Tcl_SetStringObj (result_ptr
->obj_ptr
,
613 "wrong # args, should be \"gdb_eval expression\"", -1);
617 expr
= parse_expression (Tcl_GetStringFromObj (objv
[1], NULL
));
619 old_chain
= make_cleanup ((make_cleanup_func
) free_current_contents
, &expr
);
621 val
= evaluate_expression (expr
);
624 * Print the result of the expression evaluation. This will go to
625 * eventually go to gdbtk_fputs, and from there be collected into
629 val_print (VALUE_TYPE (val
), VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
630 gdb_stdout
, 0, 0, 0, 0);
632 do_cleanups (old_chain
);
637 /* This implements the tcl command "gdb_cmd".
639 * It sends its argument to the GDB command scanner for execution.
640 * This command will never cause the update, idle and busy hooks to be called
644 * command - The GDB command to execute
646 * The output from the gdb command (except for the "load" & "while"
647 * which dump their output to the console.
651 gdb_cmd (clientData
, interp
, objc
, objv
)
652 ClientData clientData
;
655 Tcl_Obj
*CONST objv
[];
660 Tcl_SetStringObj (result_ptr
->obj_ptr
, "wrong # args", -1);
664 if (running_now
|| load_in_progress
)
669 /* for the load instruction (and possibly others later) we
670 set turn off the GDBTK_TO_RESULT flag bit so gdbtk_fputs()
671 will not buffer all the data until the command is finished. */
673 if ((strncmp ("load ", Tcl_GetStringFromObj (objv
[1], NULL
), 5) == 0))
675 result_ptr
->flags
&= ~GDBTK_TO_RESULT
;
676 load_in_progress
= 1;
679 execute_command (Tcl_GetStringFromObj (objv
[1], NULL
), 1);
681 if (load_in_progress
)
683 load_in_progress
= 0;
684 result_ptr
->flags
|= GDBTK_TO_RESULT
;
687 bpstat_do_actions (&stop_bpstat
);
693 * This implements the tcl command "gdb_immediate"
695 * It does exactly the same thing as gdb_cmd, except NONE of its outut
696 * is buffered. This will also ALWAYS cause the busy, update, and idle hooks to
697 * be called, contrasted with gdb_cmd, which NEVER calls them.
698 * It turns off the GDBTK_TO_RESULT flag, which diverts the result
699 * to the console window.
702 * command - The GDB command to execute
708 gdb_immediate_command (clientData
, interp
, objc
, objv
)
709 ClientData clientData
;
712 Tcl_Obj
*CONST objv
[];
717 Tcl_SetStringObj (result_ptr
->obj_ptr
, "wrong # args", -1);
721 if (running_now
|| load_in_progress
)
726 result_ptr
->flags
&= ~GDBTK_TO_RESULT
;
728 execute_command (Tcl_GetStringFromObj (objv
[1], NULL
), 1);
730 bpstat_do_actions (&stop_bpstat
);
732 result_ptr
->flags
|= GDBTK_TO_RESULT
;
737 /* This implements the tcl command "gdb_prompt"
739 * It returns the gdb interpreter's prompt.
748 gdb_prompt_command (clientData
, interp
, objc
, objv
)
749 ClientData clientData
;
752 Tcl_Obj
*CONST objv
[];
754 Tcl_SetStringObj (result_ptr
->obj_ptr
, get_prompt (), -1);
760 * This section contains general informational commands.
763 /* This implements the tcl command "gdb_target_has_execution"
765 * Tells whether the target is executing.
770 * A boolean indicating whether the target is executing.
774 gdb_target_has_execution_command (clientData
, interp
, objc
, objv
)
775 ClientData clientData
;
778 Tcl_Obj
*CONST objv
[];
782 if (target_has_execution
&& inferior_pid
!= 0)
785 Tcl_SetBooleanObj (result_ptr
->obj_ptr
, result
);
789 /* This implements the tcl command "gdb_load_info"
791 * It returns information about the file about to be downloaded.
794 * filename: The file to open & get the info on.
796 * A list consisting of the name and size of each section.
800 gdb_load_info (clientData
, interp
, objc
, objv
)
801 ClientData clientData
;
804 Tcl_Obj
*CONST objv
[];
807 struct cleanup
*old_cleanups
;
811 char *filename
= Tcl_GetStringFromObj (objv
[1], NULL
);
813 loadfile_bfd
= bfd_openr (filename
, gnutarget
);
814 if (loadfile_bfd
== NULL
)
816 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Open failed", -1);
819 old_cleanups
= make_cleanup ((make_cleanup_func
) bfd_close
, loadfile_bfd
);
821 if (!bfd_check_format (loadfile_bfd
, bfd_object
))
823 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Bad Object File", -1);
827 Tcl_SetListObj (result_ptr
->obj_ptr
, 0, NULL
);
829 for (s
= loadfile_bfd
->sections
; s
; s
= s
->next
)
831 if (s
->flags
& SEC_LOAD
)
833 bfd_size_type size
= bfd_get_section_size_before_reloc (s
);
836 ob
[0] = Tcl_NewStringObj ((char *) bfd_get_section_name (loadfile_bfd
, s
), -1);
837 ob
[1] = Tcl_NewLongObj ((long) size
);
838 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewListObj (2, ob
));
843 do_cleanups (old_cleanups
);
849 * This and gdb_get_locals just call gdb_get_vars_command with the right
850 * value of clientData. We can't use the client data in the definition
851 * of the command, because the call wrapper uses this instead...
855 gdb_get_locals_command (clientData
, interp
, objc
, objv
)
856 ClientData clientData
;
859 Tcl_Obj
*CONST objv
[];
862 return gdb_get_vars_command((ClientData
) 0, interp
, objc
, objv
);
867 gdb_get_args_command (clientData
, interp
, objc
, objv
)
868 ClientData clientData
;
871 Tcl_Obj
*CONST objv
[];
874 return gdb_get_vars_command((ClientData
) 1, interp
, objc
, objv
);
878 /* This implements the tcl commands "gdb_get_locals" and "gdb_get_args"
880 * This function sets the Tcl interpreter's result to a list of variable names
881 * depending on clientData. If clientData is one, the result is a list of
882 * arguments; zero returns a list of locals -- all relative to the block
883 * specified as an argument to the command. Valid commands include
884 * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
888 * block - the address within which to specify the locals or args.
890 * A list of the locals or args
894 gdb_get_vars_command (clientData
, interp
, objc
, objv
)
895 ClientData clientData
;
898 Tcl_Obj
*CONST objv
[];
900 struct symtabs_and_lines sals
;
903 char **canonical
, *args
;
904 int i
, nsyms
, arguments
;
908 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
,
909 "wrong # of args: should be \"",
910 Tcl_GetStringFromObj (objv
[0], NULL
),
911 " function:line|function|line|*addr\"", NULL
);
915 arguments
= (int) clientData
;
916 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
917 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
920 Tcl_SetStringObj (result_ptr
->obj_ptr
,
921 "error decoding line", -1);
925 /* Initialize the result pointer to an empty list. */
927 Tcl_SetListObj (result_ptr
->obj_ptr
, 0, NULL
);
929 /* Resolve all line numbers to PC's */
930 for (i
= 0; i
< sals
.nelts
; i
++)
931 resolve_sal_pc (&sals
.sals
[i
]);
933 block
= block_for_pc (sals
.sals
[0].pc
);
936 nsyms
= BLOCK_NSYMS (block
);
937 for (i
= 0; i
< nsyms
; i
++)
939 sym
= BLOCK_SYM (block
, i
);
940 switch (SYMBOL_CLASS (sym
)) {
942 case LOC_UNDEF
: /* catches errors */
943 case LOC_CONST
: /* constant */
944 case LOC_TYPEDEF
: /* local typedef */
945 case LOC_LABEL
: /* local label */
946 case LOC_BLOCK
: /* local function */
947 case LOC_CONST_BYTES
: /* loc. byte seq. */
948 case LOC_UNRESOLVED
: /* unresolved static */
949 case LOC_OPTIMIZED_OUT
: /* optimized out */
951 case LOC_ARG
: /* argument */
952 case LOC_REF_ARG
: /* reference arg */
953 case LOC_REGPARM
: /* register arg */
954 case LOC_REGPARM_ADDR
: /* indirect register arg */
955 case LOC_LOCAL_ARG
: /* stack arg */
956 case LOC_BASEREG_ARG
: /* basereg arg */
958 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
,
959 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
961 case LOC_LOCAL
: /* stack local */
962 case LOC_BASEREG
: /* basereg local */
963 case LOC_STATIC
: /* static */
964 case LOC_REGISTER
: /* register */
966 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
,
967 Tcl_NewStringObj (SYMBOL_NAME (sym
), -1));
971 if (BLOCK_FUNCTION (block
))
974 block
= BLOCK_SUPERBLOCK (block
);
980 /* This implements the tcl command "gdb_get_line"
982 * It returns the linenumber for a given linespec. It will take any spec
983 * that can be passed to decode_line_1
986 * linespec - the line specification
988 * The line number for that spec.
991 gdb_get_line_command (clientData
, interp
, objc
, objv
)
992 ClientData clientData
;
995 Tcl_Obj
*CONST objv
[];
997 struct symtabs_and_lines sals
;
998 char *args
, **canonical
;
1002 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "wrong # of args: should be \"",
1003 Tcl_GetStringFromObj (objv
[0], NULL
),
1004 " linespec\"", NULL
);
1008 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
1009 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
1010 if (sals
.nelts
== 1)
1012 Tcl_SetIntObj (result_ptr
->obj_ptr
, sals
.sals
[0].line
);
1016 Tcl_SetStringObj (result_ptr
->obj_ptr
, "N/A", -1);
1021 /* This implements the tcl command "gdb_get_file"
1023 * It returns the file containing a given line spec.
1026 * linespec - The linespec to look up
1028 * The file containing it.
1032 gdb_get_file_command (clientData
, interp
, objc
, objv
)
1033 ClientData clientData
;
1036 Tcl_Obj
*CONST objv
[];
1038 struct symtabs_and_lines sals
;
1039 char *args
, **canonical
;
1043 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "wrong # of args: should be \"",
1044 Tcl_GetStringFromObj (objv
[0], NULL
),
1045 " linespec\"", NULL
);
1049 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
1050 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
1051 if (sals
.nelts
== 1)
1053 Tcl_SetStringObj (result_ptr
->obj_ptr
, sals
.sals
[0].symtab
->filename
, -1);
1057 Tcl_SetStringObj (result_ptr
->obj_ptr
, "N/A", -1);
1061 /* This implements the tcl command "gdb_get_function"
1063 * It finds the function containing the given line spec.
1066 * linespec - The line specification
1068 * The function that contains it, or "N/A" if it is not in a function.
1071 gdb_get_function_command (clientData
, interp
, objc
, objv
)
1072 ClientData clientData
;
1075 Tcl_Obj
*CONST objv
[];
1078 struct symtabs_and_lines sals
;
1079 char *args
, **canonical
;
1083 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "wrong # of args: should be \"",
1084 Tcl_GetStringFromObj (objv
[0], NULL
),
1085 " linespec\"", NULL
);
1089 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
1090 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
1091 if (sals
.nelts
== 1)
1093 resolve_sal_pc (&sals
.sals
[0]);
1094 find_pc_partial_function (sals
.sals
[0].pc
, &function
, NULL
, NULL
);
1095 if (function
!= NULL
)
1097 Tcl_SetStringObj (result_ptr
->obj_ptr
, function
, -1);
1102 Tcl_SetStringObj (result_ptr
->obj_ptr
, "N/A", -1);
1106 /* This implements the tcl command "gdb_find_file"
1108 * It searches the symbol tables to get the full pathname to a file.
1111 * filename: the file name to search for.
1113 * The full path to the file, or an empty string if the file is not
1118 gdb_find_file_command (clientData
, interp
, objc
, objv
)
1119 ClientData clientData
;
1122 Tcl_Obj
*CONST objv
[];
1124 char *filename
= NULL
;
1129 Tcl_WrongNumArgs(interp
, 1, objv
, "filename");
1133 st
= full_lookup_symtab (Tcl_GetStringFromObj (objv
[1], NULL
));
1135 filename
= st
->fullname
;
1137 if (filename
== NULL
)
1138 Tcl_SetStringObj (result_ptr
->obj_ptr
, "", 0);
1140 Tcl_SetStringObj (result_ptr
->obj_ptr
, filename
, -1);
1145 /* This implements the tcl command "gdb_listfiles"
1147 * This lists all the files in the current executible.
1149 * Note that this currently pulls in all sorts of filenames
1150 * that aren't really part of the executable. It would be
1151 * best if we could check each file to see if it actually
1152 * contains executable lines of code, but we can't do that
1156 * ?pathname? - If provided, only files which match pathname
1157 * (up to strlen(pathname)) are included. THIS DOES NOT
1158 * CURRENTLY WORK BECAUSE PARTIAL_SYMTABS DON'T SUPPLY
1159 * THE FULL PATHNAME!!!
1162 * A list of all matching files.
1165 gdb_listfiles (clientData
, interp
, objc
, objv
)
1166 ClientData clientData
;
1169 Tcl_Obj
*CONST objv
[];
1171 struct objfile
*objfile
;
1172 struct partial_symtab
*psymtab
;
1173 struct symtab
*symtab
;
1174 char *lastfile
, *pathname
=NULL
, **files
;
1176 int i
, numfiles
= 0, len
= 0;
1179 files
= (char **) xmalloc (sizeof (char *) * files_size
);
1183 Tcl_WrongNumArgs (interp
, 1, objv
, "Usage: gdb_listfiles ?pathname?");
1187 pathname
= Tcl_GetStringFromObj (objv
[1], &len
);
1189 ALL_PSYMTABS (objfile
, psymtab
)
1191 if (numfiles
== files_size
)
1193 files_size
= files_size
* 2;
1194 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1196 if (psymtab
->filename
)
1198 if (!len
|| !strncmp(pathname
, psymtab
->filename
,len
)
1199 || !strcmp(psymtab
->filename
, basename(psymtab
->filename
)))
1201 files
[numfiles
++] = basename(psymtab
->filename
);
1206 ALL_SYMTABS (objfile
, symtab
)
1208 if (numfiles
== files_size
)
1210 files_size
= files_size
* 2;
1211 files
= (char **) xrealloc (files
, sizeof (char *) * files_size
);
1213 if (symtab
->filename
&& symtab
->linetable
&& symtab
->linetable
->nitems
)
1215 if (!len
|| !strncmp(pathname
, symtab
->filename
,len
)
1216 || !strcmp(symtab
->filename
, basename(symtab
->filename
)))
1218 files
[numfiles
++] = basename(symtab
->filename
);
1223 qsort (files
, numfiles
, sizeof(char *), comp_files
);
1227 /* Discard the old result pointer, in case it has accumulated anything
1228 and set it to a new list object */
1230 Tcl_SetListObj(result_ptr
->obj_ptr
, 0, NULL
);
1232 for (i
= 0; i
< numfiles
; i
++)
1234 if (strcmp(files
[i
],lastfile
))
1235 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewStringObj(files
[i
], -1));
1236 lastfile
= files
[i
];
1244 comp_files (file1
, file2
)
1245 const void *file1
, *file2
;
1247 return strcmp(* (char **) file1
, * (char **) file2
);
1251 /* This implements the tcl command "gdb_search"
1255 * option - One of "functions", "variables" or "types"
1256 * regexp - The regular expression to look for.
1265 gdb_search (clientData
, interp
, objc
, objv
)
1266 ClientData clientData
;
1269 Tcl_Obj
*CONST objv
[];
1271 struct symbol_search
*ss
= NULL
;
1272 struct symbol_search
*p
;
1273 struct cleanup
*old_chain
= NULL
;
1274 Tcl_Obj
*CONST
*switch_objv
;
1275 int index
, switch_objc
, i
;
1276 namespace_enum space
= 0;
1278 int static_only
, nfiles
;
1279 Tcl_Obj
**file_list
;
1281 static char *search_options
[] = { "functions", "variables", "types", (char *) NULL
};
1282 static char *switches
[] = { "-files", "-static", (char *) NULL
};
1283 enum search_opts
{ SEARCH_FUNCTIONS
, SEARCH_VARIABLES
, SEARCH_TYPES
};
1284 enum switches_opts
{ SWITCH_FILES
, SWITCH_STATIC_ONLY
};
1288 Tcl_WrongNumArgs (interp
, 1, objv
, "option regexp ?arg ...?");
1289 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1293 if (Tcl_GetIndexFromObj (interp
, objv
[1], search_options
, "option", 0,
1296 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1300 /* Unfortunately, we cannot teach search_symbols to search on
1301 multiple regexps, so we have to do a two-tier search for
1302 any searches which choose to narrow the playing field. */
1303 switch ((enum search_opts
) index
)
1305 case SEARCH_FUNCTIONS
:
1306 space
= FUNCTIONS_NAMESPACE
; break;
1307 case SEARCH_VARIABLES
:
1308 space
= VARIABLES_NAMESPACE
; break;
1310 space
= TYPES_NAMESPACE
; break;
1313 regexp
= Tcl_GetStringFromObj (objv
[2], NULL
);
1314 /* Process any switches that refine the search */
1315 switch_objc
= objc
- 3;
1316 switch_objv
= objv
+ 3;
1320 files
= (char **) NULL
;
1321 while (switch_objc
> 0)
1323 if (Tcl_GetIndexFromObj (interp
, switch_objv
[0], switches
,
1324 "option", 0, &index
) != TCL_OK
)
1326 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1330 switch ((enum switches_opts
) index
)
1335 if (switch_objc
< 2)
1337 Tcl_WrongNumArgs (interp
, 2, objv
, "[-files fileList -static 1|0]");
1338 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1341 result
= Tcl_ListObjGetElements (interp
, switch_objv
[1], &nfiles
, &file_list
);
1342 if (result
!= TCL_OK
)
1345 files
= (char **) xmalloc (nfiles
* sizeof (char *));
1346 for (i
= 0; i
< nfiles
; i
++)
1347 files
[i
] = Tcl_GetStringFromObj (file_list
[i
], NULL
);
1352 case SWITCH_STATIC_ONLY
:
1353 if (switch_objc
< 2)
1355 Tcl_WrongNumArgs (interp
, 2, objv
, "[-files fileList] [-static 1|0]");
1356 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1359 if ( Tcl_GetBooleanFromObj (interp
, switch_objv
[1], &static_only
) !=
1361 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1371 search_symbols (regexp
, space
, nfiles
, files
, &ss
);
1373 old_chain
= make_cleanup ((make_cleanup_func
) free_search_symbols
, ss
);
1375 Tcl_SetListObj(result_ptr
->obj_ptr
, 0, NULL
);
1377 for (p
= ss
; p
!= NULL
; p
= p
->next
)
1381 if (static_only
&& p
->block
!= STATIC_BLOCK
)
1384 elem
= Tcl_NewListObj (0, NULL
);
1386 if (p
->msymbol
== NULL
)
1387 Tcl_ListObjAppendElement (interp
, elem
,
1388 Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p
->symbol
), -1));
1390 Tcl_ListObjAppendElement (interp
, elem
,
1391 Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p
->msymbol
), -1));
1393 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, elem
);
1397 do_cleanups (old_chain
);
1402 /* This implements the tcl command gdb_listfuncs
1404 * It lists all the functions defined in a given file
1407 * file - the file to look in
1409 * A list of two element lists, the first element is
1410 * the symbol name, and the second is a boolean indicating
1411 * whether the symbol is demangled (1 for yes).
1415 gdb_listfuncs (clientData
, interp
, objc
, objv
)
1416 ClientData clientData
;
1419 Tcl_Obj
*CONST objv
[];
1421 struct symtab
*symtab
;
1422 struct blockvector
*bv
;
1426 Tcl_Obj
*funcVals
[2];
1430 Tcl_SetStringObj (result_ptr
->obj_ptr
, "wrong # args", -1);
1433 symtab
= full_lookup_symtab (Tcl_GetStringFromObj (objv
[1], NULL
));
1436 Tcl_SetStringObj (result_ptr
->obj_ptr
, "No such file", -1);
1440 if (mangled
== NULL
)
1442 mangled
= Tcl_NewBooleanObj(1);
1443 not_mangled
= Tcl_NewBooleanObj(0);
1444 Tcl_IncrRefCount(mangled
);
1445 Tcl_IncrRefCount(not_mangled
);
1448 Tcl_SetListObj (result_ptr
->obj_ptr
, 0, NULL
);
1450 bv
= BLOCKVECTOR (symtab
);
1451 for (i
= GLOBAL_BLOCK
; i
<= STATIC_BLOCK
; i
++)
1453 b
= BLOCKVECTOR_BLOCK (bv
, i
);
1454 /* Skip the sort if this block is always sorted. */
1455 if (!BLOCK_SHOULD_SORT (b
))
1456 sort_block_syms (b
);
1457 for (j
= 0; j
< BLOCK_NSYMS (b
); j
++)
1459 sym
= BLOCK_SYM (b
, j
);
1460 if (SYMBOL_CLASS (sym
) == LOC_BLOCK
)
1463 char *name
= cplus_demangle (SYMBOL_NAME(sym
), 0);
1466 /* strip out "global constructors" and "global destructors" */
1467 /* because we aren't interested in them. */
1468 if (strncmp (name
, "global ", 7))
1470 funcVals
[0] = Tcl_NewStringObj(name
, -1);
1471 funcVals
[1] = mangled
;
1479 funcVals
[0] = Tcl_NewStringObj(SYMBOL_NAME(sym
), -1);
1480 funcVals
[1] = not_mangled
;
1482 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
1483 Tcl_NewListObj (2, funcVals
));
1492 * This section contains all the commands that act on the registers:
1495 /* This is a sort of mapcar function for operations on registers */
1498 map_arg_registers (objc
, objv
, func
, argp
)
1500 Tcl_Obj
*CONST objv
[];
1501 void (*func
) PARAMS ((int regnum
, void *argp
));
1506 /* Note that the test for a valid register must include checking the
1507 reg_names array because NUM_REGS may be allocated for the union of the
1508 register sets within a family of related processors. In this case, the
1509 trailing entries of reg_names will change depending upon the particular
1510 processor being debugged. */
1512 if (objc
== 0) /* No args, just do all the regs */
1516 && reg_names
[regnum
] != NULL
1517 && *reg_names
[regnum
] != '\000';
1519 func (regnum
, argp
);
1524 /* Else, list of register #s, just do listed regs */
1525 for (; objc
> 0; objc
--, objv
++)
1527 if (Tcl_GetIntFromObj (NULL
, *objv
, ®num
) != TCL_OK
)
1529 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1534 && regnum
< NUM_REGS
1535 && reg_names
[regnum
] != NULL
1536 && *reg_names
[regnum
] != '\000')
1537 func (regnum
, argp
);
1540 Tcl_SetStringObj (result_ptr
->obj_ptr
, "bad register number", -1);
1548 /* This implements the TCL command `gdb_regnames', which returns a list of
1549 all of the register names. */
1552 gdb_regnames (clientData
, interp
, objc
, objv
)
1553 ClientData clientData
;
1556 Tcl_Obj
*CONST objv
[];
1561 return map_arg_registers (objc
, objv
, get_register_name
, NULL
);
1565 get_register_name (regnum
, argp
)
1567 void *argp
; /* Ignored */
1569 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
1570 Tcl_NewStringObj (reg_names
[regnum
], -1));
1573 /* This implements the tcl command gdb_fetch_registers
1574 * Pass it a list of register names, and it will
1575 * return their values as a list.
1578 * format: The format string for printing the values
1579 * args: the registers to look for
1581 * A list of their values.
1585 gdb_fetch_registers (clientData
, interp
, objc
, objv
)
1586 ClientData clientData
;
1589 Tcl_Obj
*CONST objv
[];
1595 Tcl_SetStringObj (result_ptr
->obj_ptr
,
1596 "wrong # args, should be gdb_fetch_registers format ?register1 register2 ...?", -1);
1600 format
= *(Tcl_GetStringFromObj(objv
[0], NULL
));
1604 result_ptr
->flags
|= GDBTK_MAKES_LIST
; /* Output the results as a list */
1605 result
= map_arg_registers (objc
, objv
, get_register
, (void *) format
);
1606 result_ptr
->flags
&= ~GDBTK_MAKES_LIST
;
1612 get_register (regnum
, fp
)
1616 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
1617 char virtual_buffer
[MAX_REGISTER_VIRTUAL_SIZE
];
1618 int format
= (int)fp
;
1623 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
1625 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
1626 Tcl_NewStringObj ("Optimized out", -1));
1630 /* Convert raw data to virtual format if necessary. */
1632 if (REGISTER_CONVERTIBLE (regnum
))
1634 REGISTER_CONVERT_TO_VIRTUAL (regnum
, REGISTER_VIRTUAL_TYPE (regnum
),
1635 raw_buffer
, virtual_buffer
);
1638 memcpy (virtual_buffer
, raw_buffer
, REGISTER_VIRTUAL_SIZE (regnum
));
1643 printf_filtered ("0x");
1644 for (j
= 0; j
< REGISTER_RAW_SIZE (regnum
); j
++)
1646 register int idx
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? j
1647 : REGISTER_RAW_SIZE (regnum
) - 1 - j
;
1648 printf_filtered ("%02x", (unsigned char)raw_buffer
[idx
]);
1652 val_print (REGISTER_VIRTUAL_TYPE (regnum
), virtual_buffer
, 0,
1653 gdb_stdout
, format
, 1, 0, Val_pretty_default
);
1657 /* This implements the tcl command get_pc_reg
1658 * It returns the value of the PC register
1663 * The value of the pc register.
1667 get_pc_register (clientData
, interp
, objc
, objv
)
1668 ClientData clientData
;
1671 Tcl_Obj
*CONST objv
[];
1675 sprintf (buff
, "0x%llx",(long long) read_register (PC_REGNUM
));
1676 Tcl_SetStringObj(result_ptr
->obj_ptr
, buff
, -1);
1680 /* This implements the tcl command "gdb_changed_register_list"
1681 * It takes a list of registers, and returns a list of
1682 * the registers on that list that have changed since the last
1683 * time the proc was called.
1686 * A list of registers.
1688 * A list of changed registers.
1692 gdb_changed_register_list (clientData
, interp
, objc
, objv
)
1693 ClientData clientData
;
1696 Tcl_Obj
*CONST objv
[];
1701 return map_arg_registers (objc
, objv
, register_changed_p
, NULL
);
1705 register_changed_p (regnum
, argp
)
1707 void *argp
; /* Ignored */
1709 char raw_buffer
[MAX_REGISTER_RAW_SIZE
];
1711 if (read_relative_register_raw_bytes (regnum
, raw_buffer
))
1714 if (memcmp (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1715 REGISTER_RAW_SIZE (regnum
)) == 0)
1718 /* Found a changed register. Save new value and return its number. */
1720 memcpy (&old_regs
[REGISTER_BYTE (regnum
)], raw_buffer
,
1721 REGISTER_RAW_SIZE (regnum
));
1723 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewIntObj(regnum
));
1727 * This section contains the commands that deal with tracepoints:
1730 /* return a list of all tracepoint numbers in interpreter */
1732 gdb_get_tracepoint_list (clientData
, interp
, objc
, objv
)
1733 ClientData clientData
;
1736 Tcl_Obj
*CONST objv
[];
1738 struct tracepoint
*tp
;
1740 Tcl_SetListObj (result_ptr
->obj_ptr
, 0, NULL
);
1742 ALL_TRACEPOINTS (tp
)
1743 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (tp
->number
));
1748 /* returns -1 if not found, tracepoint # if found */
1750 tracepoint_exists (char * args
)
1752 struct tracepoint
*tp
;
1754 struct symtabs_and_lines sals
;
1758 sals
= decode_line_1 (&args
, 1, NULL
, 0, &canonical
);
1759 if (sals
.nelts
== 1)
1761 resolve_sal_pc (&sals
.sals
[0]);
1762 file
= xmalloc (strlen (sals
.sals
[0].symtab
->dirname
)
1763 + strlen (sals
.sals
[0].symtab
->filename
) + 1);
1766 strcpy (file
, sals
.sals
[0].symtab
->dirname
);
1767 strcat (file
, sals
.sals
[0].symtab
->filename
);
1769 ALL_TRACEPOINTS (tp
)
1771 if (tp
->address
== sals
.sals
[0].pc
)
1772 result
= tp
->number
;
1774 /* Why is this here? This messes up assembly traces */
1775 else if (tp
->source_file
!= NULL
1776 && strcmp (tp
->source_file
, file
) == 0
1777 && sals
.sals
[0].line
== tp
->line_number
)
1778 result
= tp
->number
;
1789 gdb_tracepoint_exists_command (clientData
, interp
, objc
, objv
)
1790 ClientData clientData
;
1793 Tcl_Obj
*CONST objv
[];
1799 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "wrong # of args: should be \"",
1800 Tcl_GetStringFromObj (objv
[0], NULL
),
1801 " function:line|function|line|*addr\"", NULL
);
1805 args
= Tcl_GetStringFromObj (objv
[1], NULL
);
1807 Tcl_SetIntObj (result_ptr
->obj_ptr
, tracepoint_exists (args
));
1812 gdb_get_tracepoint_info (clientData
, interp
, objc
, objv
)
1813 ClientData clientData
;
1816 Tcl_Obj
*CONST objv
[];
1818 struct symtab_and_line sal
;
1820 struct tracepoint
*tp
;
1821 struct action_line
*al
;
1822 Tcl_Obj
*action_list
;
1823 char *filename
, *funcname
;
1828 Tcl_SetStringObj (result_ptr
->obj_ptr
, "wrong # args", -1);
1832 if (Tcl_GetIntFromObj (NULL
, objv
[1], &tpnum
) != TCL_OK
)
1834 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
1838 ALL_TRACEPOINTS (tp
)
1839 if (tp
->number
== tpnum
)
1844 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Tracepoint #%d does not exist", -1);
1848 Tcl_SetListObj (result_ptr
->obj_ptr
, 0, NULL
);
1849 sal
= find_pc_line (tp
->address
, 0);
1850 filename
= symtab_to_filename (sal
.symtab
);
1851 if (filename
== NULL
)
1853 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
,
1854 Tcl_NewStringObj (filename
, -1));
1855 find_pc_partial_function (tp
->address
, &funcname
, NULL
, NULL
);
1856 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewStringObj (funcname
, -1));
1857 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (sal
.line
));
1858 sprintf (tmp
, "0x%lx", tp
->address
);
1859 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewStringObj (tmp
, -1));
1860 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (tp
->enabled
));
1861 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (tp
->pass_count
));
1862 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (tp
->step_count
));
1863 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (tp
->thread
));
1864 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, Tcl_NewIntObj (tp
->hit_count
));
1866 /* Append a list of actions */
1867 action_list
= Tcl_NewObj ();
1868 for (al
= tp
->actions
; al
!= NULL
; al
= al
->next
)
1870 Tcl_ListObjAppendElement (interp
, action_list
,
1871 Tcl_NewStringObj (al
->action
, -1));
1873 Tcl_ListObjAppendElement (interp
, result_ptr
->obj_ptr
, action_list
);
1880 gdb_trace_status (clientData
, interp
, objc
, objv
)
1881 ClientData clientData
;
1884 Tcl_Obj
*CONST objv
[];
1888 if (trace_running_p
)
1891 Tcl_SetIntObj (result_ptr
->obj_ptr
, result
);
1898 gdb_get_trace_frame_num (clientData
, interp
, objc
, objv
)
1899 ClientData clientData
;
1902 Tcl_Obj
*CONST objv
[];
1906 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "wrong # of args: should be \"",
1907 Tcl_GetStringFromObj (objv
[0], NULL
),
1908 " linespec\"", NULL
);
1912 Tcl_SetIntObj (result_ptr
->obj_ptr
, get_traceframe_number ());
1917 /* This implements the tcl command gdb_actions
1918 * It sets actions for a given tracepoint.
1921 * number: the tracepoint in question
1922 * actions: the actions to add to this tracepoint
1928 gdb_actions_command (clientData
, interp
, objc
, objv
)
1929 ClientData clientData
;
1932 Tcl_Obj
*CONST objv
[];
1934 struct tracepoint
*tp
;
1936 int nactions
, i
, len
;
1937 char *number
, *args
, *action
;
1939 struct action_line
*next
= NULL
, *temp
;
1940 enum actionline_type linetype
;
1944 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "wrong # args: should be: \"",
1945 Tcl_GetStringFromObj (objv
[0], NULL
),
1946 " number actions\"", NULL
);
1950 args
= number
= Tcl_GetStringFromObj (objv
[1], NULL
);
1951 tp
= get_tracepoint_by_number (&args
);
1954 Tcl_AppendStringsToObj (result_ptr
->obj_ptr
, "Tracepoint \"", number
, "\" does not exist", NULL
);
1958 /* Free any existing actions */
1959 if (tp
->actions
!= NULL
)
1964 Tcl_ListObjGetElements (interp
, objv
[2], &nactions
, &actions
);
1966 /* Add the actions to the tracepoint */
1967 for (i
= 0; i
< nactions
; i
++)
1969 temp
= xmalloc (sizeof (struct action_line
));
1971 action
= Tcl_GetStringFromObj (actions
[i
], &len
);
1972 temp
->action
= savestring (action
, len
);
1974 linetype
= validate_actionline (&(temp
->action
), tp
);
1976 if (linetype
== BADLINE
)
1998 * This section has commands that handle source disassembly.
2001 /* This implements the tcl command gdb_disassemble
2004 * source_with_assm - must be "source" or "nosource"
2005 * low_address - the address from which to start disassembly
2006 * ?hi_address? - the address to which to disassemble, defaults
2007 * to the end of the function containing low_address.
2009 * The disassembled code is passed to fputs_unfiltered, so it
2010 * either goes to the console if result_ptr->obj_ptr is NULL or to
2015 gdb_disassemble (clientData
, interp
, objc
, objv
)
2016 ClientData clientData
;
2019 Tcl_Obj
*CONST objv
[];
2021 CORE_ADDR pc
, low
, high
;
2022 int mixed_source_and_assembly
;
2023 static disassemble_info di
;
2024 static int di_initialized
;
2027 if (objc
!= 3 && objc
!= 4)
2028 error ("wrong # args");
2030 if (! di_initialized
)
2032 INIT_DISASSEMBLE_INFO_NO_ARCH (di
, gdb_stdout
,
2033 (fprintf_ftype
) fprintf_unfiltered
);
2034 di
.flavour
= bfd_target_unknown_flavour
;
2035 di
.memory_error_func
= dis_asm_memory_error
;
2036 di
.print_address_func
= dis_asm_print_address
;
2040 di
.mach
= tm_print_insn_info
.mach
;
2041 if (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
2042 di
.endian
= BFD_ENDIAN_BIG
;
2044 di
.endian
= BFD_ENDIAN_LITTLE
;
2046 arg_ptr
= Tcl_GetStringFromObj (objv
[1], NULL
);
2047 if (*arg_ptr
== 's' && strcmp (arg_ptr
, "source") == 0)
2048 mixed_source_and_assembly
= 1;
2049 else if (*arg_ptr
== 'n' && strcmp (arg_ptr
, "nosource") == 0)
2050 mixed_source_and_assembly
= 0;
2052 error ("First arg must be 'source' or 'nosource'");
2054 low
= parse_and_eval_address (Tcl_GetStringFromObj (objv
[2], NULL
));
2058 if (find_pc_partial_function (low
, NULL
, &low
, &high
) == 0)
2059 error ("No function contains specified address");
2062 high
= parse_and_eval_address (Tcl_GetStringFromObj (objv
[3], NULL
));
2064 /* If disassemble_from_exec == -1, then we use the following heuristic to
2065 determine whether or not to do disassembly from target memory or from the
2068 If we're debugging a local process, read target memory, instead of the
2069 exec file. This makes disassembly of functions in shared libs work
2072 Else, we're debugging a remote process, and should disassemble from the
2073 exec file for speed. However, this is no good if the target modifies its
2074 code (for relocation, or whatever).
2077 if (disassemble_from_exec
== -1)
2079 if (strcmp (target_shortname
, "child") == 0
2080 || strcmp (target_shortname
, "procfs") == 0
2081 || strcmp (target_shortname
, "vxprocess") == 0)
2082 disassemble_from_exec
= 0; /* It's a child process, read inferior mem */
2084 disassemble_from_exec
= 1; /* It's remote, read the exec file */
2087 if (disassemble_from_exec
)
2088 di
.read_memory_func
= gdbtk_dis_asm_read_memory
;
2090 di
.read_memory_func
= dis_asm_read_memory
;
2092 /* If just doing straight assembly, all we need to do is disassemble
2093 everything between low and high. If doing mixed source/assembly, we've
2094 got a totally different path to follow. */
2096 if (mixed_source_and_assembly
)
2097 { /* Come here for mixed source/assembly */
2098 /* The idea here is to present a source-O-centric view of a function to
2099 the user. This means that things are presented in source order, with
2100 (possibly) out of order assembly immediately following. */
2101 struct symtab
*symtab
;
2102 struct linetable_entry
*le
;
2105 struct my_line_entry
*mle
;
2106 struct symtab_and_line sal
;
2111 symtab
= find_pc_symtab (low
); /* Assume symtab is valid for whole PC range */
2113 if (!symtab
|| !symtab
->linetable
)
2116 /* First, convert the linetable to a bunch of my_line_entry's. */
2118 le
= symtab
->linetable
->item
;
2119 nlines
= symtab
->linetable
->nitems
;
2124 mle
= (struct my_line_entry
*) alloca (nlines
* sizeof (struct my_line_entry
));
2128 /* Copy linetable entries for this function into our data structure, creating
2129 end_pc's and setting out_of_order as appropriate. */
2131 /* First, skip all the preceding functions. */
2133 for (i
= 0; i
< nlines
- 1 && le
[i
].pc
< low
; i
++) ;
2135 /* Now, copy all entries before the end of this function. */
2138 for (; i
< nlines
- 1 && le
[i
].pc
< high
; i
++)
2140 if (le
[i
].line
== le
[i
+ 1].line
2141 && le
[i
].pc
== le
[i
+ 1].pc
)
2142 continue; /* Ignore duplicates */
2144 mle
[newlines
].line
= le
[i
].line
;
2145 if (le
[i
].line
> le
[i
+ 1].line
)
2147 mle
[newlines
].start_pc
= le
[i
].pc
;
2148 mle
[newlines
].end_pc
= le
[i
+ 1].pc
;
2152 /* If we're on the last line, and it's part of the function, then we need to
2153 get the end pc in a special way. */
2158 mle
[newlines
].line
= le
[i
].line
;
2159 mle
[newlines
].start_pc
= le
[i
].pc
;
2160 sal
= find_pc_line (le
[i
].pc
, 0);
2161 mle
[newlines
].end_pc
= sal
.end
;
2165 /* Now, sort mle by line #s (and, then by addresses within lines). */
2168 qsort (mle
, newlines
, sizeof (struct my_line_entry
), compare_lines
);
2170 /* Now, for each line entry, emit the specified lines (unless they have been
2171 emitted before), followed by the assembly code for that line. */
2173 next_line
= 0; /* Force out first line */
2174 for (i
= 0; i
< newlines
; i
++)
2176 /* Print out everything from next_line to the current line. */
2178 if (mle
[i
].line
>= next_line
)
2181 print_source_lines (symtab
, next_line
, mle
[i
].line
+ 1, 0);
2183 print_source_lines (symtab
, mle
[i
].line
, mle
[i
].line
+ 1, 0);
2185 next_line
= mle
[i
].line
+ 1;
2188 for (pc
= mle
[i
].start_pc
; pc
< mle
[i
].end_pc
; )
2191 fputs_unfiltered (" ", gdb_stdout
);
2192 print_address (pc
, gdb_stdout
);
2193 fputs_unfiltered (":\t ", gdb_stdout
);
2194 pc
+= (*tm_print_insn
) (pc
, &di
);
2195 fputs_unfiltered ("\n", gdb_stdout
);
2202 for (pc
= low
; pc
< high
; )
2205 fputs_unfiltered (" ", gdb_stdout
);
2206 print_address (pc
, gdb_stdout
);
2207 fputs_unfiltered (":\t ", gdb_stdout
);
2208 pc
+= (*tm_print_insn
) (pc
, &di
);
2209 fputs_unfiltered ("\n", gdb_stdout
);
2213 gdb_flush (gdb_stdout
);
2218 /* This is the memory_read_func for gdb_disassemble when we are
2219 disassembling from the exec file. */
2222 gdbtk_dis_asm_read_memory (memaddr
, myaddr
, len
, info
)
2226 disassemble_info
*info
;
2228 extern struct target_ops exec_ops
;
2232 res
= xfer_memory (memaddr
, myaddr
, len
, 0, &exec_ops
);
2243 /* This will be passed to qsort to sort the results of the disassembly */
2246 compare_lines (mle1p
, mle2p
)
2250 struct my_line_entry
*mle1
, *mle2
;
2253 mle1
= (struct my_line_entry
*) mle1p
;
2254 mle2
= (struct my_line_entry
*) mle2p
;
2256 val
= mle1
->line
- mle2
->line
;
2261 return mle1
->start_pc
- mle2
->start_pc
;
2264 /* This implements the TCL command `gdb_loc',
2267 * ?symbol? The symbol or address to locate - defaults to pc
2269 * a list consisting of the following:
2270 * basename, function name, filename, line number, address, current pc
2274 gdb_loc (clientData
, interp
, objc
, objv
)
2275 ClientData clientData
;
2278 Tcl_Obj
*CONST objv
[];
2281 struct symtab_and_line sal
;
2282 char *funcname
, *fname
;
2285 if (!have_full_symbols () && !have_partial_symbols ())
2287 Tcl_SetStringObj (result_ptr
->obj_ptr
, "No symbol table is loaded", -1);
2293 if (selected_frame
&& (selected_frame
->pc
!= stop_pc
))
2295 /* Note - this next line is not correct on all architectures. */
2296 /* For a graphical debugger we really want to highlight the */
2297 /* assembly line that called the next function on the stack. */
2298 /* Many architectures have the next instruction saved as the */
2299 /* pc on the stack, so what happens is the next instruction is hughlighted. */
2301 pc
= selected_frame
->pc
;
2302 sal
= find_pc_line (selected_frame
->pc
,
2303 selected_frame
->next
!= NULL
2304 && !selected_frame
->next
->signal_handler_caller
2305 && !frame_in_dummy (selected_frame
->next
));
2310 sal
= find_pc_line (stop_pc
, 0);
2315 struct symtabs_and_lines sals
;
2318 sals
= decode_line_spec (Tcl_GetStringFromObj (objv
[1], NULL
), 1);
2324 if (sals
.nelts
!= 1)
2326 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Ambiguous line spec", -1);
2333 Tcl_SetStringObj (result_ptr
->obj_ptr
, "wrong # args", -1);
2338 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
2339 Tcl_NewStringObj (sal
.symtab
->filename
, -1));
2341 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewStringObj ("", 0));
2343 find_pc_partial_function (pc
, &funcname
, NULL
, NULL
);
2344 fname
= cplus_demangle (funcname
, 0);
2347 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
2348 Tcl_NewStringObj (fname
, -1));
2352 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
2353 Tcl_NewStringObj (funcname
, -1));
2355 filename
= symtab_to_filename (sal
.symtab
);
2356 if (filename
== NULL
)
2359 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
2360 Tcl_NewStringObj (filename
, -1));
2361 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewIntObj(sal
.line
)); /* line number */
2362 sprintf_append_element_to_obj (result_ptr
->obj_ptr
, "0x%s", paddr_nz(pc
)); /* PC in current frame */
2363 sprintf_append_element_to_obj (result_ptr
->obj_ptr
, "0x%s", paddr_nz(stop_pc
)); /* Real PC */
2367 /* This implements the Tcl command 'gdb_get_mem', which
2368 * dumps a block of memory
2370 * gdb_get_mem addr form size num aschar
2372 * addr: address of data to dump
2373 * form: a char indicating format
2374 * size: size of each element; 1,2,4, or 8 bytes
2375 * num: the number of bytes to read
2376 * acshar: an optional ascii character to use in ASCII dump
2379 * a list of elements followed by an optional ASCII dump
2383 gdb_get_mem (clientData
, interp
, objc
, objv
)
2384 ClientData clientData
;
2387 Tcl_Obj
*CONST objv
[];
2389 int size
, asize
, i
, j
, bc
;
2391 int nbytes
, rnum
, bpr
;
2393 char format
, c
, buff
[128], aschar
, *mbuf
, *mptr
, *cptr
, *bptr
;
2394 struct type
*val_type
;
2396 if (objc
< 6 || objc
> 7)
2398 Tcl_SetStringObj (result_ptr
->obj_ptr
,
2399 "addr format size bytes bytes_per_row ?ascii_char?", -1);
2403 if (Tcl_GetIntFromObj (interp
, objv
[3], &size
) != TCL_OK
)
2405 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
2410 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Invalid size, must be > 0", -1);
2414 if (Tcl_GetIntFromObj (interp
, objv
[4], &nbytes
) != TCL_OK
)
2416 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
2421 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Invalid number of bytes, must be > 0",
2426 if (Tcl_GetIntFromObj (interp
, objv
[5], &bpr
) != TCL_OK
)
2428 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
2433 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Invalid bytes per row, must be > 0", -1);
2437 if (Tcl_GetLongFromObj (interp
, objv
[1], &tmp
) != TCL_OK
)
2440 addr
= (CORE_ADDR
) tmp
;
2442 format
= *(Tcl_GetStringFromObj (objv
[2], NULL
));
2443 mbuf
= (char *)malloc (nbytes
+32);
2446 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Out of memory.", -1);
2450 memset (mbuf
, 0, nbytes
+32);
2453 rnum
= target_read_memory_partial (addr
, mbuf
, nbytes
, NULL
);
2456 aschar
= *(Tcl_GetStringFromObj(objv
[6], NULL
));
2462 val_type
= builtin_type_char
;
2466 val_type
= builtin_type_short
;
2470 val_type
= builtin_type_int
;
2474 val_type
= builtin_type_long_long
;
2478 val_type
= builtin_type_char
;
2482 bc
= 0; /* count of bytes in a row */
2483 buff
[0] = '"'; /* buffer for ascii dump */
2484 bptr
= &buff
[1]; /* pointer for ascii dump */
2486 result_ptr
->flags
|= GDBTK_MAKES_LIST
; /* Build up the result as a list... */
2488 for (i
=0; i
< nbytes
; i
+= size
)
2492 fputs_unfiltered ("N/A ", gdb_stdout
);
2494 for ( j
= 0; j
< size
; j
++)
2499 print_scalar_formatted (mptr
, val_type
, format
, asize
, gdb_stdout
);
2503 for ( j
= 0; j
< size
; j
++)
2506 if (c
< 32 || c
> 126)
2518 if (aschar
&& (bc
>= bpr
))
2520 /* end of row. print it and reset variables */
2525 fputs_unfiltered (buff
, gdb_stdout
);
2530 result_ptr
->flags
&= ~GDBTK_MAKES_LIST
;
2538 /* This implements the tcl command "gdb_loadfile"
2539 * It loads a c source file into a text widget.
2542 * widget: the name of the text widget to fill
2543 * filename: the name of the file to load
2544 * linenumbers: A boolean indicating whether or not to display line numbers.
2549 /* In this routine, we will build up a "line table", i.e. a
2550 * table of bits showing which lines in the source file are executible.
2551 * LTABLE_SIZE is the number of bytes to allocate for the line table.
2553 * Its size limits the maximum number of lines
2554 * in a file to 8 * LTABLE_SIZE. This memory is freed after
2555 * the file is loaded, so it is OK to make this very large.
2556 * Additional memory will be allocated if needed. */
2557 #define LTABLE_SIZE 20000
2559 gdb_loadfile (clientData
, interp
, objc
, objv
)
2560 ClientData clientData
;
2563 Tcl_Obj
*CONST objv
[];
2565 char *file
, *widget
;
2566 int linenumbers
, ln
, lnum
, ltable_size
;
2569 struct symtab
*symtab
;
2570 struct linetable_entry
*le
;
2573 Tcl_DString text_cmd_1
, text_cmd_2
, *cur_cmd
;
2574 char line
[1024], line_num_buf
[16];
2575 int prefix_len_1
, prefix_len_2
, cur_prefix_len
, widget_len
;
2580 Tcl_WrongNumArgs(interp
, 1, objv
, "widget filename linenumbers");
2584 widget
= Tcl_GetStringFromObj (objv
[1], NULL
);
2585 if ( Tk_NameToWindow (interp
, widget
, Tk_MainWindow (interp
)) == NULL
)
2590 file
= Tcl_GetStringFromObj (objv
[2], NULL
);
2591 Tcl_GetBooleanFromObj (interp
, objv
[3], &linenumbers
);
2593 symtab
= full_lookup_symtab (file
);
2596 Tcl_SetStringObj ( result_ptr
->obj_ptr
, "File not found in symtab", -1);
2601 file
= symtab_to_filename ( symtab
);
2602 if ((fp
= fopen ( file
, "r" )) == NULL
)
2604 Tcl_SetStringObj ( result_ptr
->obj_ptr
, "Can't open file for reading", -1);
2608 if (stat (file
, &st
) < 0)
2610 catch_errors (perror_with_name_wrapper
, "gdbtk: get time stamp", "",
2615 if (symtab
&& symtab
->objfile
&& symtab
->objfile
->obfd
)
2616 mtime
= bfd_get_mtime(symtab
->objfile
->obfd
);
2618 mtime
= bfd_get_mtime(exec_bfd
);
2620 if (mtime
&& mtime
< st
.st_mtime
)
2621 gdbtk_ignorable_warning("Source file is more recent than executable.\n");
2624 /* Source linenumbers don't appear to be in order, and a sort is */
2625 /* too slow so the fastest solution is just to allocate a huge */
2626 /* array and set the array entry for each linenumber */
2628 ltable_size
= LTABLE_SIZE
;
2629 ltable
= (char *)malloc (LTABLE_SIZE
);
2632 Tcl_SetStringObj ( result_ptr
->obj_ptr
, "Out of memory.", -1);
2637 memset (ltable
, 0, LTABLE_SIZE
);
2639 if (symtab
->linetable
&& symtab
->linetable
->nitems
)
2641 le
= symtab
->linetable
->item
;
2642 for (ln
= symtab
->linetable
->nitems
;ln
> 0; ln
--, le
++)
2644 lnum
= le
->line
>> 3;
2645 if (lnum
>= ltable_size
)
2648 new_ltable
= (char *)realloc (ltable
, ltable_size
*2);
2649 memset (new_ltable
+ ltable_size
, 0, ltable_size
);
2651 if (new_ltable
== NULL
)
2653 Tcl_SetStringObj ( result_ptr
->obj_ptr
, "Out of memory.", -1);
2658 ltable
= new_ltable
;
2660 ltable
[lnum
] |= 1 << (le
->line
% 8);
2664 Tcl_DStringInit(&text_cmd_1
);
2665 Tcl_DStringInit(&text_cmd_2
);
2669 widget_len
= strlen (widget
);
2672 Tcl_DStringAppend (&text_cmd_1
, widget
, widget_len
);
2673 Tcl_DStringAppend (&text_cmd_2
, widget
, widget_len
);
2677 Tcl_DStringAppend (&text_cmd_1
, " insert end {-\t", -1);
2678 prefix_len_1
= Tcl_DStringLength(&text_cmd_1
);
2680 Tcl_DStringAppend (&text_cmd_2
, " insert end { \t", -1);
2681 prefix_len_2
= Tcl_DStringLength(&text_cmd_2
);
2683 while (fgets (line
+ 1, 980, fp
))
2685 sprintf (line_num_buf
, "%d", ln
);
2686 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
2688 cur_cmd
= &text_cmd_1
;
2689 cur_prefix_len
= prefix_len_1
;
2690 Tcl_DStringAppend (cur_cmd
, line_num_buf
, -1);
2691 Tcl_DStringAppend (cur_cmd
, "} break_tag", 11);
2695 cur_cmd
= &text_cmd_2
;
2696 cur_prefix_len
= prefix_len_2
;
2697 Tcl_DStringAppend (cur_cmd
, line_num_buf
, -1);
2698 Tcl_DStringAppend (cur_cmd
, "} \"\"", 4);
2701 Tcl_DStringAppendElement (cur_cmd
, line
);
2702 Tcl_DStringAppend (cur_cmd
, " source_tag", 11);
2704 Tcl_Eval(interp
, Tcl_DStringValue(cur_cmd
));
2705 Tcl_DStringSetLength(cur_cmd
, cur_prefix_len
);
2711 Tcl_DStringAppend (&text_cmd_1
, " insert end {- } break_tag", -1);
2712 prefix_len_1
= Tcl_DStringLength(&text_cmd_1
);
2713 Tcl_DStringAppend (&text_cmd_2
, " insert end { } \"\"", -1);
2714 prefix_len_2
= Tcl_DStringLength(&text_cmd_2
);
2716 while (fgets (line
+ 1, 980, fp
))
2718 if (ltable
[ln
>> 3] & (1 << (ln
% 8)))
2720 cur_cmd
= &text_cmd_1
;
2721 cur_prefix_len
= prefix_len_1
;
2725 cur_cmd
= &text_cmd_2
;
2726 cur_prefix_len
= prefix_len_2
;
2729 Tcl_DStringAppendElement (cur_cmd
, line
);
2730 Tcl_DStringAppend (cur_cmd
, " source_tag", 11);
2732 Tcl_Eval(interp
, Tcl_DStringValue(cur_cmd
));
2733 Tcl_DStringSetLength(cur_cmd
, cur_prefix_len
);
2739 Tcl_DStringFree (&text_cmd_1
);
2740 Tcl_DStringFree (&text_cmd_2
);
2747 * This section contains commands for manipulation of breakpoints.
2751 /* set a breakpoint by source file and line number */
2752 /* flags are as follows: */
2753 /* least significant 2 bits are disposition, rest is */
2754 /* type (normally 0).
2757 bp_breakpoint, Normal breakpoint
2758 bp_hardware_breakpoint, Hardware assisted breakpoint
2761 Disposition of breakpoint. Ie: what to do after hitting it.
2764 del_at_next_stop, Delete at next stop, whether hit or not
2766 donttouch Leave it alone
2770 /* This implements the tcl command "gdb_set_bp"
2771 * It sets breakpoints, and runs the Tcl command
2772 * gdbtk_tcl_breakpoint create
2773 * to register the new breakpoint with the GUI.
2776 * filename: the file in which to set the breakpoint
2777 * line: the line number for the breakpoint
2778 * type: the type of the breakpoint
2779 * thread: optional thread number
2781 * The return value of the call to gdbtk_tcl_breakpoint.
2785 gdb_set_bp (clientData
, interp
, objc
, objv
)
2786 ClientData clientData
;
2789 Tcl_Obj
*CONST objv
[];
2792 struct symtab_and_line sal
;
2793 int line
, flags
, ret
, thread
= -1;
2794 struct breakpoint
*b
;
2798 if (objc
!= 4 && objc
!= 5)
2800 Tcl_WrongNumArgs(interp
, 1, objv
, "filename line type [thread]");
2804 sal
.symtab
= full_lookup_symtab (Tcl_GetStringFromObj( objv
[1], NULL
));
2805 if (sal
.symtab
== NULL
)
2808 if (Tcl_GetIntFromObj( interp
, objv
[2], &line
) == TCL_ERROR
)
2810 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2814 if (Tcl_GetIntFromObj( interp
, objv
[3], &flags
) == TCL_ERROR
)
2816 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2822 if (Tcl_GetIntFromObj( interp
, objv
[4], &thread
) == TCL_ERROR
)
2824 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2830 if (!find_line_pc (sal
.symtab
, sal
.line
, &sal
.pc
))
2833 sal
.section
= find_pc_overlay (sal
.pc
);
2834 b
= set_raw_breakpoint (sal
);
2835 set_breakpoint_count (breakpoint_count
+ 1);
2836 b
->number
= breakpoint_count
;
2837 b
->type
= flags
>> 2;
2838 b
->disposition
= flags
& 3;
2841 /* FIXME: this won't work for duplicate basenames! */
2842 sprintf (buf
, "%s:%d", basename (Tcl_GetStringFromObj ( objv
[1], NULL
)), line
);
2843 b
->addr_string
= strsave (buf
);
2845 /* now send notification command back to GUI */
2847 Tcl_DStringInit (&cmd
);
2849 Tcl_DStringAppend (&cmd
, "gdbtk_tcl_breakpoint create ", -1);
2850 sprintf (buf
, "%d", b
->number
);
2851 Tcl_DStringAppendElement(&cmd
, buf
);
2852 sprintf (buf
, "0x%lx", (long)sal
.pc
);
2853 Tcl_DStringAppendElement (&cmd
, buf
);
2854 Tcl_DStringAppendElement (&cmd
, Tcl_GetStringFromObj (objv
[2], NULL
));
2855 Tcl_DStringAppendElement (&cmd
, Tcl_GetStringFromObj (objv
[1], NULL
));
2857 ret
= Tcl_Eval (interp
, Tcl_DStringValue (&cmd
));
2858 Tcl_DStringFree (&cmd
);
2862 /* This implements the tcl command "gdb_set_bp_addr"
2863 * It sets breakpoints, and runs the Tcl command
2864 * gdbtk_tcl_breakpoint create
2865 * to register the new breakpoint with the GUI.
2868 * addr: the address at which to set the breakpoint
2869 * type: the type of the breakpoint
2870 * thread: optional thread number
2872 * The return value of the call to gdbtk_tcl_breakpoint.
2876 gdb_set_bp_addr (clientData
, interp
, objc
, objv
)
2877 ClientData clientData
;
2880 Tcl_Obj
*CONST objv
[];
2883 struct symtab_and_line sal
;
2884 int line
, flags
, ret
, thread
= -1;
2886 struct breakpoint
*b
;
2887 char *filename
, buf
[64];
2890 if (objc
!= 4 && objc
!= 3)
2892 Tcl_WrongNumArgs(interp
, 1, objv
, "addr type [thread]");
2896 if (Tcl_GetLongFromObj( interp
, objv
[1], &addr
) == TCL_ERROR
)
2898 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2902 if (Tcl_GetIntFromObj( interp
, objv
[2], &flags
) == TCL_ERROR
)
2904 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2910 if (Tcl_GetIntFromObj( interp
, objv
[3], &thread
) == TCL_ERROR
)
2912 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2917 sal
= find_pc_line (addr
, 0);
2919 b
= set_raw_breakpoint (sal
);
2920 set_breakpoint_count (breakpoint_count
+ 1);
2921 b
->number
= breakpoint_count
;
2922 b
->type
= flags
>> 2;
2923 b
->disposition
= flags
& 3;
2926 sprintf (buf
, "*(0x%lx)",addr
);
2927 b
->addr_string
= strsave (buf
);
2929 /* now send notification command back to GUI */
2931 Tcl_DStringInit (&cmd
);
2933 Tcl_DStringAppend (&cmd
, "gdbtk_tcl_breakpoint create ", -1);
2934 sprintf (buf
, "%d", b
->number
);
2935 Tcl_DStringAppendElement(&cmd
, buf
);
2936 sprintf (buf
, "0x%lx", addr
);
2937 Tcl_DStringAppendElement (&cmd
, buf
);
2938 sprintf (buf
, "%d", b
->line_number
);
2939 Tcl_DStringAppendElement (&cmd
, buf
);
2941 filename
= symtab_to_filename (sal
.symtab
);
2942 if (filename
== NULL
)
2944 Tcl_DStringAppendElement (&cmd
, filename
);
2946 ret
= Tcl_Eval (interp
, Tcl_DStringValue (&cmd
));
2947 Tcl_DStringFree (&cmd
);
2951 /* This implements the tcl command "gdb_find_bp_at_line"
2954 * filename: the file in which to find the breakpoint
2955 * line: the line number for the breakpoint
2957 * It returns a list of breakpoint numbers
2961 gdb_find_bp_at_line(clientData
, interp
, objc
, objv
)
2962 ClientData clientData
;
2965 Tcl_Obj
*CONST objv
[];
2970 struct breakpoint
*b
;
2971 extern struct breakpoint
*breakpoint_chain
;
2975 Tcl_WrongNumArgs(interp
, 1, objv
, "filename line");
2979 s
= full_lookup_symtab (Tcl_GetStringFromObj( objv
[1], NULL
));
2983 if (Tcl_GetIntFromObj( interp
, objv
[2], &line
) == TCL_ERROR
)
2985 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
2989 Tcl_SetListObj (result_ptr
->obj_ptr
,0 ,NULL
);
2990 for (b
= breakpoint_chain
; b
; b
= b
->next
)
2991 if (b
->line_number
== line
&& !strcmp(b
->source_file
, s
->filename
))
2992 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
2993 Tcl_NewIntObj (b
->number
));
2999 /* This implements the tcl command "gdb_find_bp_at_addr"
3004 * It returns a list of breakpoint numbers
3008 gdb_find_bp_at_addr(clientData
, interp
, objc
, objv
)
3009 ClientData clientData
;
3012 Tcl_Obj
*CONST objv
[];
3016 struct breakpoint
*b
;
3017 extern struct breakpoint
*breakpoint_chain
;
3021 Tcl_WrongNumArgs(interp
, 1, objv
, "address");
3025 if (Tcl_GetLongFromObj( interp
, objv
[1], &addr
) == TCL_ERROR
)
3027 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
3031 Tcl_SetListObj (result_ptr
->obj_ptr
,0 ,NULL
);
3032 for (b
= breakpoint_chain
; b
; b
= b
->next
)
3033 if (b
->address
== (CORE_ADDR
)addr
)
3034 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
3035 Tcl_NewIntObj (b
->number
));
3040 /* This implements the tcl command gdb_get_breakpoint_info
3046 * A list with {file, function, line_number, address, type, enabled?,
3047 * disposition, ignore_count, {list_of_commands}, thread, hit_count}
3051 gdb_get_breakpoint_info (clientData
, interp
, objc
, objv
)
3052 ClientData clientData
;
3055 Tcl_Obj
*CONST objv
[];
3057 struct symtab_and_line sal
;
3058 static char *bptypes
[] = {"breakpoint", "hardware breakpoint", "until",
3059 "finish", "watchpoint", "hardware watchpoint",
3060 "read watchpoint", "access watchpoint",
3061 "longjmp", "longjmp resume", "step resume",
3062 "through sigtramp", "watchpoint scope",
3064 static char *bpdisp
[] = {"delete", "delstop", "disable", "donttouch"};
3065 struct command_line
*cmd
;
3067 struct breakpoint
*b
;
3068 extern struct breakpoint
*breakpoint_chain
;
3069 char *funcname
, *fname
, *filename
;
3074 Tcl_SetStringObj (result_ptr
->obj_ptr
, "wrong number of args, should be \"breakpoint\"", -1);
3078 if ( Tcl_GetIntFromObj(NULL
, objv
[1], &bpnum
) != TCL_OK
)
3080 result_ptr
->flags
= GDBTK_IN_TCL_RESULT
;
3084 for (b
= breakpoint_chain
; b
; b
= b
->next
)
3085 if (b
->number
== bpnum
)
3088 if (!b
|| b
->type
!= bp_breakpoint
)
3090 Tcl_SetStringObj (result_ptr
->obj_ptr
, "Breakpoint #%d does not exist", -1);
3094 sal
= find_pc_line (b
->address
, 0);
3096 filename
= symtab_to_filename (sal
.symtab
);
3097 if (filename
== NULL
)
3100 Tcl_SetListObj (result_ptr
->obj_ptr
,0 ,NULL
);
3101 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
3102 Tcl_NewStringObj (filename
, -1));
3104 find_pc_partial_function (b
->address
, &funcname
, NULL
, NULL
);
3105 fname
= cplus_demangle (funcname
, 0);
3108 new_obj
= Tcl_NewStringObj (fname
, -1);
3112 new_obj
= Tcl_NewStringObj (funcname
, -1);
3114 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, new_obj
);
3116 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewIntObj (b
->line_number
));
3117 sprintf_append_element_to_obj (result_ptr
->obj_ptr
, "0x%lx", b
->address
);
3118 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
3119 Tcl_NewStringObj (bptypes
[b
->type
], -1));
3120 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewBooleanObj(b
->enable
== enabled
));
3121 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
3122 Tcl_NewStringObj (bpdisp
[b
->disposition
], -1));
3123 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewIntObj (b
->ignore_count
));
3125 new_obj
= Tcl_NewObj();
3126 for (cmd
= b
->commands
; cmd
; cmd
= cmd
->next
)
3127 Tcl_ListObjAppendElement (NULL
, new_obj
,
3128 Tcl_NewStringObj (cmd
->line
, -1));
3129 Tcl_ListObjAppendElement(NULL
, result_ptr
->obj_ptr
, new_obj
);
3131 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
,
3132 Tcl_NewStringObj (b
->cond_string
, -1));
3134 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewIntObj (b
->thread
));
3135 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, Tcl_NewIntObj (b
->hit_count
));
3141 /* This implements the tcl command gdb_get_breakpoint_list
3142 * It builds up a list of the current breakpoints.
3147 * A list of breakpoint numbers.
3151 gdb_get_breakpoint_list (clientData
, interp
, objc
, objv
)
3152 ClientData clientData
;
3155 Tcl_Obj
*CONST objv
[];
3157 struct breakpoint
*b
;
3158 extern struct breakpoint
*breakpoint_chain
;
3162 error ("wrong number of args, none are allowed");
3164 for (b
= breakpoint_chain
; b
; b
= b
->next
)
3165 if (b
->type
== bp_breakpoint
)
3167 new_obj
= Tcl_NewIntObj (b
->number
);
3168 Tcl_ListObjAppendElement (NULL
, result_ptr
->obj_ptr
, new_obj
);
3174 /* The functions in this section deal with stacks and backtraces. */
3176 /* This implements the tcl command gdb_stack.
3177 * It builds up a list of stack frames.
3180 * start - starting stack frame
3181 * count - number of frames to inspect
3183 * A list of function names
3187 gdb_stack (clientData
, interp
, objc
, objv
) ClientData clientData
;
3190 Tcl_Obj
*CONST objv
[];
3196 Tcl_WrongNumArgs (interp
, 1, objv
, "start count");
3197 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
3201 if (Tcl_GetIntFromObj (NULL
, objv
[1], &start
))
3203 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
3206 if (Tcl_GetIntFromObj (NULL
, objv
[2], &count
))
3208 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
3212 Tcl_SetListObj (result_ptr
->obj_ptr
, 0, NULL
);
3214 if (target_has_stack
)
3216 struct frame_info
*top
;
3217 struct frame_info
*fi
;
3219 /* Find the outermost frame */
3220 fi
= get_current_frame ();
3224 fi
= get_prev_frame (fi
);
3227 /* top now points to the top (outermost frame) of the
3228 stack, so point it to the requested start */
3230 top
= find_relative_frame (top
, &start
);
3232 /* If start != 0, then we have asked to start outputting
3233 frames beyond the innermost stack frame */
3237 while (fi
&& count
--)
3239 get_frame_name (interp
, result_ptr
->obj_ptr
, fi
);
3240 fi
= get_next_frame (fi
);
3248 /* A helper function for get_stack which adds information about
3249 * the stack frame FI to the caller's LIST.
3251 * This is stolen from print_frame_info in stack.c.
3254 get_frame_name (interp
, list
, fi
)
3257 struct frame_info
*fi
;
3259 struct symtab_and_line sal
;
3260 struct symbol
*func
= NULL
;
3261 register char *funname
= 0;
3262 enum language funlang
= language_unknown
;
3265 if (frame_in_dummy (fi
))
3267 objv
[0] = Tcl_NewStringObj ("<function called from gdb>\n", -1);
3268 Tcl_ListObjAppendElement (interp
, list
, objv
[0]);
3271 if (fi
->signal_handler_caller
)
3273 objv
[0] = Tcl_NewStringObj ("<signal handler called>\n", -1);
3274 Tcl_ListObjAppendElement (interp
, list
, objv
[0]);
3279 find_pc_line (fi
->pc
,
3281 && !fi
->next
->signal_handler_caller
3282 && !frame_in_dummy (fi
->next
));
3284 func
= find_pc_function (fi
->pc
);
3287 struct minimal_symbol
*msymbol
= lookup_minimal_symbol_by_pc (fi
->pc
);
3289 && (SYMBOL_VALUE_ADDRESS (msymbol
)
3290 > BLOCK_START (SYMBOL_BLOCK_VALUE (func
))))
3293 funname
= SYMBOL_NAME (msymbol
);
3294 funlang
= SYMBOL_LANGUAGE (msymbol
);
3298 funname
= SYMBOL_NAME (func
);
3299 funlang
= SYMBOL_LANGUAGE (func
);
3304 struct minimal_symbol
*msymbol
= lookup_minimal_symbol_by_pc (fi
->pc
);
3305 if (msymbol
!= NULL
)
3307 funname
= SYMBOL_NAME (msymbol
);
3308 funlang
= SYMBOL_LANGUAGE (msymbol
);
3316 if (funlang
== language_cplus
)
3317 name
= cplus_demangle (funname
, 0);
3321 objv
[0] = Tcl_NewStringObj (name
, -1);
3322 Tcl_ListObjAppendElement (interp
, list
, objv
[0]);
3327 /* we have no convenient way to deal with this yet... */
3328 if (fi
->pc
!= sal
.pc
|| !sal
.symtab
)
3330 print_address_numeric (fi
->pc
, 1, gdb_stdout
);
3331 printf_filtered (" in ");
3333 printf_symbol_filtered (gdb_stdout
, funname
? funname
: "??", funlang
,
3336 objv
[0] = Tcl_NewStringObj (funname
!= NULL
? funname
: "??", -1);
3337 #ifdef PC_LOAD_SEGMENT
3338 /* If we couldn't print out function name but if can figure out what
3339 load segment this pc value is from, at least print out some info
3340 about its load segment. */
3343 Tcl_AppendStringsToObj (objv
[0], " from ", PC_LOAD_SEGMENT (fi
->pc
),
3350 char *lib
= PC_SOLIB (fi
->pc
);
3353 Tcl_AppendStringsToObj (objv
[0], " from ", lib
, (char *) NULL
);
3357 Tcl_ListObjAppendElement (interp
, list
, objv
[0]);
3363 * This section contains a bunch of miscellaneous utility commands
3366 /* This implements the tcl command gdb_path_conv
3368 * On Windows, it canonicalizes the pathname,
3369 * On Unix, it is a no op.
3374 * The canonicalized path.
3378 gdb_path_conv (clientData
, interp
, objc
, objv
)
3379 ClientData clientData
;
3382 Tcl_Obj
*CONST objv
[];
3385 error ("wrong # args");
3389 char pathname
[256], *ptr
;
3391 cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj(objv
[1], NULL
), pathname
);
3392 for (ptr
= pathname
; *ptr
; ptr
++)
3397 Tcl_SetStringObj (result_ptr
->obj_ptr
, pathname
, -1);
3400 Tcl_SetStringObj (result_ptr
->obj_ptr
, Tcl_GetStringFromObj (objv
[1], NULL
), -1);
3407 * This section has utility routines that are not Tcl commands.
3411 perror_with_name_wrapper (args
)
3414 perror_with_name (args
);
3418 /* The lookup_symtab() in symtab.c doesn't work correctly */
3419 /* It will not work will full pathnames and if multiple */
3420 /* source files have the same basename, it will return */
3421 /* the first one instead of the correct one. This version */
3422 /* also always makes sure symtab->fullname is set. */
3424 static struct symtab
*
3425 full_lookup_symtab(file
)
3429 struct objfile
*objfile
;
3430 char *bfile
, *fullname
;
3431 struct partial_symtab
*pt
;
3436 /* first try a direct lookup */
3437 st
= lookup_symtab (file
);
3441 symtab_to_filename(st
);
3445 /* if the direct approach failed, try */
3446 /* looking up the basename and checking */
3447 /* all matches with the fullname */
3448 bfile
= basename (file
);
3449 ALL_SYMTABS (objfile
, st
)
3451 if (!strcmp (bfile
, basename(st
->filename
)))
3454 fullname
= symtab_to_filename (st
);
3456 fullname
= st
->fullname
;
3458 if (!strcmp (file
, fullname
))
3463 /* still no luck? look at psymtabs */
3464 ALL_PSYMTABS (objfile
, pt
)
3466 if (!strcmp (bfile
, basename(pt
->filename
)))
3468 st
= PSYMTAB_TO_SYMTAB (pt
);
3471 fullname
= symtab_to_filename (st
);
3472 if (!strcmp (file
, fullname
))