projects / deliverable / binutils-gdb.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
* Updated test cases to confirm PKE behavior according to new SCEI specs.
[deliverable/binutils-gdb.git] / gdb / gdbtk.c
CommitLineData
4604b34c 1/* Tcl/Tk interface routines.
a5f4fbff 2 Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
4604b34c
SG		 3
4 Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
754e5da2
SG		 5
6This file is part of GDB.
7
8This program is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 2 of the License, or
11(at your option) any later version.
12
13This program is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with this program; if not, write to the Free Software
6c9638b4 20Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
754e5da2
SG		 21
22#include "defs.h"
23#include "symtab.h"
24#include "inferior.h"
25#include "command.h"
26#include "bfd.h"
27#include "symfile.h"
28#include "objfiles.h"
29#include "target.h"
018d76dd
KS		 30#include "gdbcore.h"
31#include "tracepoint.h"
929db6e5 32#include "demangle.h"
018d76dd
KS		 33
34#ifdef _WIN32
35#include <winuser.h>
36#endif
37
754e5da2
SG		 38#include <tcl.h>
39#include <tk.h>
2476848a
MH		 40#include <itcl.h>
41#include <tix.h>
dd3dd918 42#include "guitcl.h"
2476848a
MH		 43
44#ifdef IDE
018d76dd 45/* start-sanitize-ide */
2476848a
MH		 46#include "event.h"
47#include "idetcl.h"
018d76dd
KS		 48#include "ilutk.h"
49/* end-sanitize-ide */
2476848a
MH		 50#endif
51
73d3dbd4 52#ifdef ANSI_PROTOTYPES
85c613aa
C		 53#include <stdarg.h>
54#else
cd2df226 55#include <varargs.h>
85c613aa 56#endif
cd2df226
SG		 57#include <signal.h>
58#include <fcntl.h>
8532893d 59#include <unistd.h>
86db943c
SG		 60#include <setjmp.h>
61#include "top.h"
736a82e7 62#include <sys/ioctl.h>
2b576293 63#include "gdb_string.h"
09722039 64#include "dis-asm.h"
6131622e
SG		 65#include <stdio.h>
66#include "gdbcmd.h"
736a82e7 67
8a19b35a 68#ifndef WINNT
736a82e7 69#ifndef FIOASYNC
546b8ca7
SG		 70#include <sys/stropts.h>
71#endif
8a19b35a
MH		 72#endif
73
018d76dd 74#ifdef __CYGWIN32__
929db6e5 75#include "annotate.h"
018d76dd
KS		 76#include <sys/time.h>
77#endif
78
8a19b35a
MH		 79#ifdef WINNT
80#define GDBTK_PATH_SEP ";"
81#else
82#define GDBTK_PATH_SEP ":"
83#endif
754e5da2 84
8b3f9ed6 85/* Some versions (1.3.79, 1.3.81) of Linux don't support SIOCSPGRP the way
3f37b696 86 gdbtk wants to use it... */
8b3f9ed6
MM		 87#ifdef __linux__
88#undef SIOCSPGRP
89#endif
90
0776b0b0 91static int load_in_progress = 0;
ed5fa7c3 92static int in_fputs = 0;
0776b0b0 93
018d76dd
KS		 94int gdbtk_load_hash PARAMS ((char *, unsigned long));
95int (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
11f91b2b
KS		 96void (*pre_add_symbol_hook) PARAMS ((char *));
97void (*post_add_symbol_hook) PARAMS ((void));
018d76dd 98
929db6e5
EZ		 99/* This is a disgusting hack. Unfortunately, the UI will lock up if we
100 are doing something like blocking in a system call, waiting for serial I/O,
101 or what have you.
102
103 This hook should be used whenever we might block. This means adding appropriate
104 timeouts to code and what not to allow this hook to be called. */
105void (*ui_loop_hook) PARAMS ((int));
106
107char * get_prompt PARAMS ((void));
108
b607efe7
FF		 109static void null_routine PARAMS ((int));
110static void gdbtk_flush PARAMS ((FILE *));
111static void gdbtk_fputs PARAMS ((const char *, FILE *));
112static int gdbtk_query PARAMS ((const char *, va_list));
113static char *gdbtk_readline PARAMS ((char *));
2476848a 114static void gdbtk_init PARAMS ((char *));
b607efe7
FF		 115static void tk_command_loop PARAMS ((void));
116static void gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
117static int gdbtk_wait PARAMS ((int, struct target_waitstatus *));
118static void x_event PARAMS ((int));
119static void gdbtk_interactive PARAMS ((void));
120static void cleanup_init PARAMS ((int));
121static void tk_command PARAMS ((char *, int));
122static int gdb_disassemble PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
123static int compare_lines PARAMS ((const PTR, const PTR));
124static int gdbtk_dis_asm_read_memory PARAMS ((bfd_vma, bfd_byte *, int, disassemble_info *));
8a19b35a 125static int gdb_path_conv PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
b607efe7 126static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
018d76dd
KS		 127static int gdb_confirm_quit PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
128static int gdb_force_quit PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
0776b0b0 129static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
99c98415 130static int gdb_listfuncs PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
b607efe7
FF		 131static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
132static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
0422b59e 133static int gdb_immediate_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
b607efe7
FF		 134static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
135static void gdbtk_readline_end PARAMS ((void));
929db6e5 136static void pc_changed PARAMS ((void));
b607efe7
FF		 137static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
138static void register_changed_p PARAMS ((int, void *));
139static int gdb_get_breakpoint_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
140static int gdb_get_breakpoint_info PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
141static void breakpoint_notify PARAMS ((struct breakpoint *, const char *));
142static void gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
143static void gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
144static void gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
145static int gdb_loc PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
146static int gdb_eval PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
b607efe7
FF		 147static int map_arg_registers PARAMS ((int, char *[], void (*) (int, void *), void *));
148static void get_register_name PARAMS ((int, void *));
149static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
150static void get_register PARAMS ((int, void *));
41158958 151static int gdb_trace_status PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
018d76dd
KS		 152static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
153static int gdb_load_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
0776b0b0 154void TclDebug PARAMS ((const char *fmt, ...));
018d76dd
KS		 155static int gdb_get_vars_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
156static int gdb_get_function_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
157static int gdb_get_line_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
158static int gdb_get_file_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
159static int gdb_tracepoint_exists_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
160static int gdb_get_tracepoint_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
161static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
162static int gdb_prompt_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
e0f7db02 163static int gdb_find_file_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
11f91b2b 164static char *find_file_in_dir PARAMS ((char *));
4f17e6eb 165static int gdb_get_tracepoint_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
018d76dd
KS		 166static void gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
167static void gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
a5f4fbff 168static void gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
018d76dd 169static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
a5f4fbff 170static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
11f91b2b
KS		 171void gdbtk_pre_add_symbol PARAMS ((char *));
172void gdbtk_post_add_symbol PARAMS ((void));
929db6e5
EZ		 173static int get_pc_register PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
174static int gdb_loadfile PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
175static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
176static struct symtab *full_lookup_symtab PARAMS ((char *file));
177static int gdb_get_mem PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
178#ifdef __CYGWIN32__
179static void gdbtk_annotate_starting PARAMS ((void));
180static void gdbtk_annotate_stopped PARAMS ((void));
181static void gdbtk_annotate_signalled PARAMS ((void));
182static void gdbtk_annotate_exited PARAMS ((void));
183#endif
b607efe7 184
754e5da2
SG		 185/* Handle for TCL interpreter */
186static Tcl_Interp *interp = NULL;
187
018d76dd 188#ifndef WINNT
479f0f18 189static int x_fd; /* X network socket */
018d76dd 190#endif
479f0f18 191
0776b0b0
MH		 192#ifdef __CYGWIN32__
193
194/* On Windows we use timer interrupts when gdb might otherwise hang
195 for a long time. See the comment above gdbtk_start_timer. This
196 variable is true when timer interrupts are being used. */
197
198static int gdbtk_timer_going = 0;
199
200static void gdbtk_start_timer PARAMS ((void));
201static void gdbtk_stop_timer PARAMS ((void));
202
203#endif
204
fda6fadc
SS		 205/* This variable is true when the inferior is running. Although it's
206 possible to disable most input from widgets and thus prevent
207 attempts to do anything while the inferior is running, any commands
208 that get through - even a simple memory read - are Very Bad, and
209 may cause GDB to crash or behave strangely. So, this variable
210 provides an extra layer of defense. */
09722039 211
fda6fadc
SS		 212static int running_now;
213
214/* This variable determines where memory used for disassembly is read from.
215 If > 0, then disassembly comes from the exec file rather than the
216 target (which might be at the other end of a slow serial link). If
217 == 0 then disassembly comes from target. If < 0 disassembly is
218 automatically switched to the target if it's an inferior process,
219 otherwise the exec file is used. */
09722039
SG		 220
221static int disassemble_from_exec = -1;
222
9b119644
ILT		 223#ifndef _WIN32
224
225/* Supply malloc calls for tcl/tk. We do not want to do this on
226 Windows, because Tcl_Alloc is probably in a DLL which will not call
227 the mmalloc routines. */
8c19daa1
SG		 228
229char *
a5a6e3bd 230Tcl_Alloc (size)
8c19daa1
SG		 231 unsigned int size;
232{
233 return xmalloc (size);
234}
235
236char *
237Tcl_Realloc (ptr, size)
238 char *ptr;
239 unsigned int size;
240{
241 return xrealloc (ptr, size);
242}
243
244void
245Tcl_Free(ptr)
246 char *ptr;
247{
248 free (ptr);
249}
250
018d76dd 251#endif /* ! _WIN32 */
9b119644 252
754e5da2
SG		 253static void
254null_routine(arg)
255 int arg;
256{
257}
258
018d76dd
KS		 259#ifdef _WIN32
260
261/* On Windows, if we hold a file open, other programs can't write to
262 it. In particular, we don't want to hold the executable open,
263 because it will mean that people have to get out of the debugging
264 session in order to remake their program. So we close it, although
265 this will cost us if and when we need to reopen it. */
266
267static void
268close_bfds ()
269{
270 struct objfile *o;
271
272 ALL_OBJFILES (o)
273 {
274 if (o->obfd != NULL)
275 bfd_cache_close (o->obfd);
276 }
277
278 if (exec_bfd != NULL)
279 bfd_cache_close (exec_bfd);
280}
281
282#endif /* _WIN32 */
283
546b8ca7
SG		 284/* The following routines deal with stdout/stderr data, which is created by
285 {f}printf_{un}filtered and friends. gdbtk_fputs and gdbtk_flush are the
286 lowest level of these routines and capture all output from the rest of GDB.
287 Normally they present their data to tcl via callbacks to the following tcl
288 routines: gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush. These
289 in turn call tk routines to update the display.
86db943c 290
546b8ca7
SG		 291 Under some circumstances, you may want to collect the output so that it can
292 be returned as the value of a tcl procedure. This can be done by
293 surrounding the output routines with calls to start_saving_output and
294 finish_saving_output. The saved data can then be retrieved with
295 get_saved_output (but this must be done before the call to
296 finish_saving_output). */
86db943c 297
018d76dd 298/* Dynamic string for output. */
86db943c 299
6131622e 300static Tcl_DString *result_ptr;
018d76dd
KS		 301
302/* Dynamic string for stderr. This is only used if result_ptr is
303 NULL. */
304
305static Tcl_DString *error_string_ptr;
754e5da2 306\f
754e5da2
SG		 307static void
308gdbtk_flush (stream)
309 FILE *stream;
310{
6131622e 311#if 0
86db943c
SG		 312 /* Force immediate screen update */
313
754e5da2 314 Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
6131622e 315#endif
754e5da2
SG		 316}
317
8532893d 318static void
86db943c 319gdbtk_fputs (ptr, stream)
8532893d 320 const char *ptr;
86db943c 321 FILE *stream;
8532893d 322{
ed5fa7c3
MH		 323 char *merge[2], *command;
324 in_fputs = 1;
325
6131622e 326 if (result_ptr)
018d76dd
KS		 327 Tcl_DStringAppend (result_ptr, (char *) ptr, -1);
328 else if (error_string_ptr != NULL && stream == gdb_stderr)
329 Tcl_DStringAppend (error_string_ptr, (char *) ptr, -1);
6131622e 330 else
86db943c 331 {
ed5fa7c3
MH		 332 merge[0] = "gdbtk_tcl_fputs";
333 merge[1] = (char *)ptr;
334 command = Tcl_Merge (2, merge);
335 Tcl_Eval (interp, command);
336 Tcl_Free (command);
6131622e 337 }
ed5fa7c3 338 in_fputs = 0;
8532893d
SG		 339}
340
754e5da2 341static int
85c613aa 342gdbtk_query (query, args)
b607efe7 343 const char *query;
754e5da2
SG		 344 va_list args;
345{
4e327047
TT		 346 char buf[200], *merge[2];
347 char *command;
754e5da2
SG		 348 long val;
349
6131622e 350 vsprintf (buf, query, args);
4e327047
TT		 351 merge[0] = "gdbtk_tcl_query";
352 merge[1] = buf;
353 command = Tcl_Merge (2, merge);
354 Tcl_Eval (interp, command);
018d76dd 355 Tcl_Free (command);
754e5da2
SG		 356
357 val = atol (interp->result);
358 return val;
359}
41756e56
FF		 360
361/* VARARGS */
362static void
363#ifdef ANSI_PROTOTYPES
364gdbtk_readline_begin (char *format, ...)
365#else
366gdbtk_readline_begin (va_alist)
367 va_dcl
368#endif
369{
370 va_list args;
371 char buf[200], *merge[2];
372 char *command;
373
374#ifdef ANSI_PROTOTYPES
375 va_start (args, format);
376#else
377 char *format;
378 va_start (args);
379 format = va_arg (args, char *);
380#endif
381
382 vsprintf (buf, format, args);
383 merge[0] = "gdbtk_tcl_readline_begin";
384 merge[1] = buf;
385 command = Tcl_Merge (2, merge);
386 Tcl_Eval (interp, command);
929db6e5 387 Tcl_Free (command);
41756e56
FF		 388}
389
390static char *
391gdbtk_readline (prompt)
392 char *prompt;
393{
394 char *merge[2];
395 char *command;
bd45f82f 396 int result;
41756e56 397
018d76dd
KS		 398#ifdef _WIN32
399 close_bfds ();
400#endif
401
41756e56
FF		 402 merge[0] = "gdbtk_tcl_readline";
403 merge[1] = prompt;
404 command = Tcl_Merge (2, merge);
bd45f82f 405 result = Tcl_Eval (interp, command);
929db6e5 406 Tcl_Free (command);
bd45f82f 407 if (result == TCL_OK)
41756e56
FF		 408 {
409 return (strdup (interp -> result));
410 }
411 else
412 {
413 gdbtk_fputs (interp -> result, gdb_stdout);
414 gdbtk_fputs ("\n", gdb_stdout);
415 return (NULL);
416 }
417}
418
419static void
420gdbtk_readline_end ()
421{
422 Tcl_Eval (interp, "gdbtk_tcl_readline_end");
423}
424
929db6e5
EZ		 425static void
426pc_changed()
427{
428 Tcl_Eval (interp, "gdbtk_pc_changed");
429}
430
754e5da2 431\f
6131622e 432static void
73d3dbd4 433#ifdef ANSI_PROTOTYPES
85c613aa
C		 434dsprintf_append_element (Tcl_DString *dsp, char *format, ...)
435#else
6131622e
SG		 436dsprintf_append_element (va_alist)
437 va_dcl
85c613aa 438#endif
6131622e
SG		 439{
440 va_list args;
85c613aa
C		 441 char buf[1024];
442
73d3dbd4 443#ifdef ANSI_PROTOTYPES
85c613aa
C		 444 va_start (args, format);
445#else
6131622e
SG		 446 Tcl_DString *dsp;
447 char *format;
6131622e
SG		 448
449 va_start (args);
6131622e
SG		 450 dsp = va_arg (args, Tcl_DString *);
451 format = va_arg (args, char *);
85c613aa 452#endif
6131622e
SG		 453
454 vsprintf (buf, format, args);
455
456 Tcl_DStringAppendElement (dsp, buf);
457}
458
8a19b35a
MH		 459static int
460gdb_path_conv (clientData, interp, argc, argv)
461 ClientData clientData;
462 Tcl_Interp *interp;
463 int argc;
464 char *argv[];
465{
466#ifdef WINNT
467 char pathname[256], *ptr;
468 if (argc != 2)
469 error ("wrong # args");
470 cygwin32_conv_to_full_win32_path (argv[1], pathname);
471 for (ptr = pathname; *ptr; ptr++)
472 {
473 if (*ptr == '\\')
474 *ptr = '/';
475 }
476#else
477 char *pathname = argv[1];
478#endif
479 Tcl_DStringAppend (result_ptr, pathname, strlen(pathname));
480 return TCL_OK;
481}
482
6131622e
SG		 483static int
484gdb_get_breakpoint_list (clientData, interp, argc, argv)
485 ClientData clientData;
486 Tcl_Interp *interp;
487 int argc;
488 char *argv[];
489{
490 struct breakpoint *b;
491 extern struct breakpoint *breakpoint_chain;
492
493 if (argc != 1)
494 error ("wrong # args");
495
496 for (b = breakpoint_chain; b; b = b->next)
497 if (b->type == bp_breakpoint)
498 dsprintf_append_element (result_ptr, "%d", b->number);
499
500 return TCL_OK;
501}
502
503static int
504gdb_get_breakpoint_info (clientData, interp, argc, argv)
505 ClientData clientData;
506 Tcl_Interp *interp;
507 int argc;
508 char *argv[];
509{
510 struct symtab_and_line sal;
511 static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
512 "finish", "watchpoint", "hardware watchpoint",
513 "read watchpoint", "access watchpoint",
514 "longjmp", "longjmp resume", "step resume",
515 "through sigtramp", "watchpoint scope",
516 "call dummy" };
27f1958c 517 static char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
6131622e
SG		 518 struct command_line *cmd;
519 int bpnum;
520 struct breakpoint *b;
521 extern struct breakpoint *breakpoint_chain;
929db6e5
EZ		 522 char *funcname, *fname, *filename;
523
6131622e
SG		 524 if (argc != 2)
525 error ("wrong # args");
526
527 bpnum = atoi (argv[1]);
528
529 for (b = breakpoint_chain; b; b = b->next)
530 if (b->number == bpnum)
531 break;
532
9468f8aa 533 if (!b || b->type != bp_breakpoint)
6131622e
SG		 534 error ("Breakpoint #%d does not exist", bpnum);
535
6131622e
SG		 536 sal = find_pc_line (b->address, 0);
537
6c3908db
KS		 538 filename = symtab_to_filename (sal.symtab);
539 if (filename == NULL)
11f91b2b 540 filename = "";
84f71d63 541 Tcl_DStringAppendElement (result_ptr, filename);
929db6e5 542
018d76dd 543 find_pc_partial_function (b->address, &funcname, NULL, NULL);
929db6e5
EZ		 544 fname = cplus_demangle (funcname, 0);
545 if (fname)
546 {
547 Tcl_DStringAppendElement (result_ptr, fname);
548 free (fname);
549 }
550 else
551 Tcl_DStringAppendElement (result_ptr, funcname);
552 dsprintf_append_element (result_ptr, "%d", b->line_number);
6131622e
SG		 553 dsprintf_append_element (result_ptr, "0x%lx", b->address);
554 Tcl_DStringAppendElement (result_ptr, bptypes[b->type]);
555 Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0");
556 Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]);
6131622e
SG		 557 dsprintf_append_element (result_ptr, "%d", b->ignore_count);
558
559 Tcl_DStringStartSublist (result_ptr);
560 for (cmd = b->commands; cmd; cmd = cmd->next)
561 Tcl_DStringAppendElement (result_ptr, cmd->line);
562 Tcl_DStringEndSublist (result_ptr);
563
564 Tcl_DStringAppendElement (result_ptr, b->cond_string);
565
566 dsprintf_append_element (result_ptr, "%d", b->thread);
567 dsprintf_append_element (result_ptr, "%d", b->hit_count);
568
569 return TCL_OK;
570}
571
754e5da2
SG		 572static void
573breakpoint_notify(b, action)
574 struct breakpoint *b;
575 const char *action;
576{
32707df8 577 char buf[256];
754e5da2 578 int v;
2476848a 579 struct symtab_and_line sal;
6c3908db 580 char *filename;
754e5da2
SG		 581
582 if (b->type != bp_breakpoint)
583 return;
584
4e327047
TT		 585 /* We ensure that ACTION contains no special Tcl characters, so we
586 can do this. */
2476848a 587 sal = find_pc_line (b->address, 0);
6c3908db
KS		 588 filename = symtab_to_filename (sal.symtab);
589 if (filename == NULL)
929db6e5
EZ		 590 filename = "";
591
2476848a 592 sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number,
929db6e5 593 (long)b->address, b->line_number, filename);
754e5da2 594
6131622e 595 v = Tcl_Eval (interp, buf);
754e5da2
SG		 596
597 if (v != TCL_OK)
598 {
546b8ca7
SG		 599 gdbtk_fputs (interp->result, gdb_stdout);
600 gdbtk_fputs ("\n", gdb_stdout);
754e5da2 601 }
754e5da2
SG		 602}
603
604static void
605gdbtk_create_breakpoint(b)
606 struct breakpoint *b;
607{
6131622e 608 breakpoint_notify (b, "create");
754e5da2
SG		 609}
610
611static void
612gdbtk_delete_breakpoint(b)
613 struct breakpoint *b;
614{
6131622e 615 breakpoint_notify (b, "delete");
754e5da2
SG		 616}
617
618static void
6131622e 619gdbtk_modify_breakpoint(b)
754e5da2
SG		 620 struct breakpoint *b;
621{
6131622e 622 breakpoint_notify (b, "modify");
754e5da2
SG		 623}
624\f
929db6e5
EZ		 625/* This implements the TCL command `gdb_loc', which returns a list */
626/* consisting of the following: */
627/* basename, function name, filename, line number, address, current pc */
754e5da2
SG		 628
629static int
630gdb_loc (clientData, interp, argc, argv)
631 ClientData clientData;
632 Tcl_Interp *interp;
633 int argc;
634 char *argv[];
635{
636 char *filename;
754e5da2 637 struct symtab_and_line sal;
929db6e5 638 char *funcname, *fname;
8532893d 639 CORE_ADDR pc;
754e5da2 640
018d76dd
KS		 641 if (!have_full_symbols () && !have_partial_symbols ())
642 {
643 Tcl_SetResult (interp, "No symbol table is loaded", TCL_STATIC);
644 return TCL_ERROR;
645 }
929db6e5 646
754e5da2
SG		 647 if (argc == 1)
648 {
929db6e5 649 if (selected_frame && (selected_frame->pc != stop_pc))
0776b0b0 650 {
929db6e5
EZ		 651 /* Note - this next line is not correct on all architectures. */
652 /* For a graphical debugged we really want to highlight the */
653 /* assembly line that called the next function on the stack. */
654 /* Many architectures have the next instruction saved as the */
655 /* pc on the stack, so what happens is the next instruction is hughlighted. */
656 /* FIXME */
657 pc = selected_frame->pc;
0776b0b0
MH		 658 sal = find_pc_line (selected_frame->pc,
659 selected_frame->next != NULL
660 && !selected_frame->next->signal_handler_caller
661 && !frame_in_dummy (selected_frame->next));
662 }
663 else
929db6e5
EZ		 664 {
665 pc = stop_pc;
666 sal = find_pc_line (stop_pc, 0);
667 }
754e5da2
SG		 668 }
669 else if (argc == 2)
670 {
754e5da2 671 struct symtabs_and_lines sals;
8532893d 672 int nelts;
754e5da2
SG		 673
674 sals = decode_line_spec (argv[1], 1);
675
8532893d
SG		 676 nelts = sals.nelts;
677 sal = sals.sals[0];
678 free (sals.sals);
679
754e5da2 680 if (sals.nelts != 1)
6131622e 681 error ("Ambiguous line spec");
ed5fa7c3
MH		 682
683 pc = sal.pc;
754e5da2
SG		 684 }
685 else
6131622e 686 error ("wrong # args");
754e5da2 687
754e5da2 688 if (sal.symtab)
6131622e 689 Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
754e5da2 690 else
6131622e 691 Tcl_DStringAppendElement (result_ptr, "");
8532893d
SG		 692
693 find_pc_partial_function (pc, &funcname, NULL, NULL);
929db6e5
EZ		 694 fname = cplus_demangle (funcname, 0);
695 if (fname)
696 {
697 Tcl_DStringAppendElement (result_ptr, fname);
698 free (fname);
699 }
700 else
701 Tcl_DStringAppendElement (result_ptr, funcname);
637b1661 702 filename = symtab_to_filename (sal.symtab);
6c3908db 703 if (filename == NULL)
929db6e5 704 filename = "";
8532893d 705
0776b0b0 706 Tcl_DStringAppendElement (result_ptr, filename);
9468f8aa 707 dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
2476848a 708 dsprintf_append_element (result_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
2476848a 709 dsprintf_append_element (result_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
754e5da2
SG		 710 return TCL_OK;
711}
712\f
09722039
SG		 713/* This implements the TCL command `gdb_eval'. */
714
715static int
716gdb_eval (clientData, interp, argc, argv)
717 ClientData clientData;
718 Tcl_Interp *interp;
719 int argc;
720 char *argv[];
721{
722 struct expression *expr;
723 struct cleanup *old_chain;
724 value_ptr val;
725
726 if (argc != 2)
6131622e 727 error ("wrong # args");
09722039
SG		 728
729 expr = parse_expression (argv[1]);
730
731 old_chain = make_cleanup (free_current_contents, &expr);
732
733 val = evaluate_expression (expr);
734
09722039
SG		 735 val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
736 gdb_stdout, 0, 0, 0, 0);
09722039
SG		 737
738 do_cleanups (old_chain);
739
740 return TCL_OK;
741}
018d76dd
KS		 742
743/* gdb_get_mem addr form size num aschar*/
744/* dump a block of memory */
745/* addr: address of data to dump */
746/* form: a char indicating format */
747/* size: size of each element; 1,2,4, or 8 bytes*/
ac3dff67
EZ		 748/* num: the number of bytes to read */
749/* acshar: an optional ascii character to use in ASCII dump */
750/* returns a list of elements followed by an optional */
018d76dd 751/* ASCII dump */
ac3dff67 752
018d76dd
KS		 753static int
754gdb_get_mem (clientData, interp, argc, argv)
755 ClientData clientData;
756 Tcl_Interp *interp;
757 int argc;
758 char *argv[];
759{
ac3dff67
EZ		 760 int size, asize, i, j, bc;
761 CORE_ADDR addr;
762 int nbytes, rnum, bpr;
763 char format, c, *ptr, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
018d76dd 764 struct type *val_type;
018d76dd 765
ac3dff67
EZ		 766 if (argc < 6 || argc > 7)
767 {
768 interp->result = "addr format size bytes bytes_per_row ?ascii_char?";
769 return TCL_ERROR;
770 }
771
772 size = (int)strtoul(argv[3],(char **)NULL,0);
773 nbytes = (int)strtoul(argv[4],(char **)NULL,0);
774 bpr = (int)strtoul(argv[5],(char **)NULL,0);
775 if (nbytes <= 0 || bpr <= 0 || size <= 0)
776 {
777 interp->result = "Invalid number of bytes.";
778 return TCL_ERROR;
779 }
018d76dd
KS		 780
781 addr = (CORE_ADDR)strtoul(argv[1],(char **)NULL,0);
018d76dd 782 format = *argv[2];
ac3dff67
EZ		 783 mbuf = (char *)malloc (nbytes+32);
784 if (!mbuf)
785 {
786 interp->result = "Out of memory.";
787 return TCL_ERROR;
788 }
789 memset (mbuf, 0, nbytes+32);
790 mptr = cptr = mbuf;
791
792 rnum = target_read_memory_partial (addr, mbuf, nbytes, NULL);
793
794 if (argv[6])
795 aschar = *argv[6];
796 else
797 aschar = 0;
018d76dd
KS		 798
799 switch (size) {
800 case 1:
801 val_type = builtin_type_char;
802 asize = 'b';
803 break;
804 case 2:
805 val_type = builtin_type_short;
806 asize = 'h';
807 break;
808 case 4:
809 val_type = builtin_type_int;
810 asize = 'w';
811 break;
812 case 8:
813 val_type = builtin_type_long_long;
814 asize = 'g';
815 break;
816 default:
817 val_type = builtin_type_char;
818 asize = 'b';
819 }
820
ac3dff67
EZ		 821 bc = 0; /* count of bytes in a row */
822 buff[0] = '"'; /* buffer for ascii dump */
823 bptr = &buff[1]; /* pointer for ascii dump */
824
825 for (i=0; i < nbytes; i+= size)
018d76dd 826 {
ac3dff67
EZ		 827 if ( i >= rnum)
828 {
829 fputs_unfiltered ("N/A ", gdb_stdout);
830 if (aschar)
831 for ( j = 0; j < size; j++)
832 *bptr++ = 'X';
833 }
834 else
835 {
836 print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
837 fputs_unfiltered (" ", gdb_stdout);
838 if (aschar)
839 {
840 for ( j = 0; j < size; j++)
841 {
842 c = *cptr++;
843 if (c < 32 || c > 126)
844 c = aschar;
845 if (c == '"')
846 *bptr++ = '\\';
847 *bptr++ = c;
848 }
849 }
850 }
018d76dd 851
ac3dff67
EZ		 852 mptr += size;
853 bc += size;
854
855 if (aschar && (bc >= bpr))
018d76dd 856 {
ac3dff67
EZ		 857 /* end of row. print it and reset variables */
858 bc = 0;
859 *bptr++ = '"';
860 *bptr++ = ' ';
861 *bptr = 0;
862 fputs_unfiltered (buff, gdb_stdout);
863 bptr = &buff[1];
018d76dd 864 }
018d76dd 865 }
ac3dff67
EZ		 866
867 free (mbuf);
018d76dd
KS		 868 return TCL_OK;
869}
870
746d1df4
SG		 871static int
872map_arg_registers (argc, argv, func, argp)
873 int argc;
874 char *argv[];
6131622e 875 void (*func) PARAMS ((int regnum, void *argp));
746d1df4
SG		 876 void *argp;
877{
878 int regnum;
879
880 /* Note that the test for a valid register must include checking the
881 reg_names array because NUM_REGS may be allocated for the union of the
882 register sets within a family of related processors. In this case, the
883 trailing entries of reg_names will change depending upon the particular
884 processor being debugged. */
885
886 if (argc == 0) /* No args, just do all the regs */
887 {
888 for (regnum = 0;
889 regnum < NUM_REGS
890 && reg_names[regnum] != NULL
891 && *reg_names[regnum] != '\000';
892 regnum++)
893 func (regnum, argp);
894
895 return TCL_OK;
896 }
897
898 /* Else, list of register #s, just do listed regs */
899 for (; argc > 0; argc--, argv++)
900 {
901 regnum = atoi (*argv);
902
903 if (regnum >= 0
904 && regnum < NUM_REGS
905 && reg_names[regnum] != NULL
906 && *reg_names[regnum] != '\000')
907 func (regnum, argp);
908 else
6131622e 909 error ("bad register number");
746d1df4
SG		 910 }
911
912 return TCL_OK;
913}
914
6131622e 915static void
746d1df4
SG		 916get_register_name (regnum, argp)
917 int regnum;
918 void *argp; /* Ignored */
919{
6131622e 920 Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
746d1df4
SG		 921}
922
5b21fb68
SG		 923/* This implements the TCL command `gdb_regnames', which returns a list of
924 all of the register names. */
925
926static int
927gdb_regnames (clientData, interp, argc, argv)
928 ClientData clientData;
929 Tcl_Interp *interp;
930 int argc;
931 char *argv[];
932{
746d1df4
SG		 933 argc--;
934 argv++;
935
b607efe7 936 return map_arg_registers (argc, argv, get_register_name, NULL);
746d1df4
SG		 937}
938
746d1df4
SG		 939#ifndef REGISTER_CONVERTIBLE
940#define REGISTER_CONVERTIBLE(x) (0 != 0)
941#endif
942
943#ifndef REGISTER_CONVERT_TO_VIRTUAL
944#define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
945#endif
946
947#ifndef INVALID_FLOAT
948#define INVALID_FLOAT(x, y) (0 != 0)
949#endif
950
6131622e 951static void
746d1df4 952get_register (regnum, fp)
6131622e 953 int regnum;
746d1df4
SG		 954 void *fp;
955{
956 char raw_buffer[MAX_REGISTER_RAW_SIZE];
957 char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
958 int format = (int)fp;
959
929db6e5
EZ		 960 if (format == 'N')
961 format = 0;
962
746d1df4
SG		 963 if (read_relative_register_raw_bytes (regnum, raw_buffer))
964 {
6131622e 965 Tcl_DStringAppendElement (result_ptr, "Optimized out");
746d1df4
SG		 966 return;
967 }
968
746d1df4
SG		 969 /* Convert raw data to virtual format if necessary. */
970
971 if (REGISTER_CONVERTIBLE (regnum))
972 {
973 REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
974 raw_buffer, virtual_buffer);
975 }
976 else
977 memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
978
3d9f68c0
FF		 979 if (format == 'r')
980 {
981 int j;
982 printf_filtered ("0x");
983 for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
984 {
985 register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
986 : REGISTER_RAW_SIZE (regnum) - 1 - j;
987 printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
988 }
989 }
990 else
991 val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
992 gdb_stdout, format, 1, 0, Val_pretty_default);
746d1df4 993
6131622e 994 Tcl_DStringAppend (result_ptr, " ", -1);
746d1df4
SG		 995}
996
929db6e5
EZ		 997static int
998get_pc_register (clientData, interp, argc, argv)
999 ClientData clientData;
1000 Tcl_Interp *interp;
1001 int argc;
1002 char *argv[];
1003{
1004 sprintf(interp->result,"0x%llx",(long long)read_register(PC_REGNUM));
1005 return TCL_OK;
1006}
1007
746d1df4
SG		 1008static int
1009gdb_fetch_registers (clientData, interp, argc, argv)
1010 ClientData clientData;
1011 Tcl_Interp *interp;
1012 int argc;
1013 char *argv[];
1014{
1015 int format;
1016
1017 if (argc < 2)
6131622e 1018 error ("wrong # args");
5b21fb68 1019
929db6e5 1020 argc -= 2;
746d1df4 1021 argv++;
746d1df4 1022 format = **argv++;
929db6e5 1023
b607efe7 1024 return map_arg_registers (argc, argv, get_register, (void *) format);
746d1df4
SG		 1025}
1026
1027/* This contains the previous values of the registers, since the last call to
1028 gdb_changed_register_list. */
1029
1030static char old_regs[REGISTER_BYTES];
1031
6131622e 1032static void
746d1df4 1033register_changed_p (regnum, argp)
6131622e 1034 int regnum;
746d1df4
SG		 1035 void *argp; /* Ignored */
1036{
1037 char raw_buffer[MAX_REGISTER_RAW_SIZE];
746d1df4
SG		 1038
1039 if (read_relative_register_raw_bytes (regnum, raw_buffer))
1040 return;
1041
1042 if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
1043 REGISTER_RAW_SIZE (regnum)) == 0)
1044 return;
1045
fda6fadc 1046 /* Found a changed register. Save new value and return its number. */
746d1df4
SG		 1047
1048 memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
1049 REGISTER_RAW_SIZE (regnum));
1050
9468f8aa 1051 dsprintf_append_element (result_ptr, "%d", regnum);
746d1df4
SG		 1052}
1053
1054static int
1055gdb_changed_register_list (clientData, interp, argc, argv)
1056 ClientData clientData;
1057 Tcl_Interp *interp;
1058 int argc;
1059 char *argv[];
1060{
746d1df4
SG		 1061 argc--;
1062 argv++;
1063
1064 return map_arg_registers (argc, argv, register_changed_p, NULL);
5b21fb68
SG		 1065}
1066\f
0422b59e
KS		 1067/* This implements the tcl command "gdb_immediate", which does exactly
1068 the same thing as gdb_cmd, except NONE of its outut is buffered. */
1069static int
1070gdb_immediate_command (clientData, interp, argc, argv)
1071 ClientData clientData;
1072 Tcl_Interp *interp;
1073 int argc;
1074 char *argv[];
1075{
1076 Tcl_DString *save_ptr = NULL;
1077
1078 if (argc != 2)
1079 error ("wrong # args");
1080
ed5fa7c3 1081 if (running_now || load_in_progress)
0422b59e
KS		 1082 return TCL_OK;
1083
1084 Tcl_DStringAppend (result_ptr, "", -1);
1085 save_ptr = result_ptr;
1086 result_ptr = NULL;
1087
1088 execute_command (argv[1], 1);
1089
1090 bpstat_do_actions (&stop_bpstat);
1091
1092 result_ptr = save_ptr;
1093
1094 return TCL_OK;
1095}
1096
fda6fadc 1097/* This implements the TCL command `gdb_cmd', which sends its argument into
754e5da2
SG		 1098 the GDB command scanner. */
1099
1100static int
1101gdb_cmd (clientData, interp, argc, argv)
1102 ClientData clientData;
1103 Tcl_Interp *interp;
1104 int argc;
1105 char *argv[];
1106{
018d76dd
KS		 1107 Tcl_DString *save_ptr = NULL;
1108
754e5da2 1109 if (argc != 2)
6131622e 1110 error ("wrong # args");
754e5da2 1111
ed5fa7c3 1112 if (running_now || load_in_progress)
fda6fadc
SS		 1113 return TCL_OK;
1114
018d76dd
KS		 1115 /* for the load instruction (and possibly others later) we
1116 set result_ptr to NULL so gdbtk_fputs() will not buffer
1117 all the data until the command is finished. */
1118
4f17e6eb
KS		 1119 if (strncmp ("load ", argv[1], 5) == 0
1120 || strncmp ("while ", argv[1], 6) == 0)
1121 {
1122 Tcl_DStringAppend (result_ptr, "", -1);
1123 save_ptr = result_ptr;
1124 result_ptr = NULL;
0776b0b0
MH		 1125 load_in_progress = 1;
1126
1127 /* On Windows, use timer interrupts so that the user can cancel
1128 the download. FIXME: We may have to do something on other
1129 systems. */
1130#ifdef __CYGWIN32__
1131 gdbtk_start_timer ();
1132#endif
4f17e6eb 1133 }
018d76dd 1134
86db943c 1135 execute_command (argv[1], 1);
479f0f18 1136
0776b0b0
MH		 1137#ifdef __CYGWIN32__
1138 if (load_in_progress)
1139 gdbtk_stop_timer ();
1140#endif
1141
1142 load_in_progress = 0;
754e5da2 1143 bpstat_do_actions (&stop_bpstat);
018d76dd
KS		 1144
1145 if (save_ptr)
1146 result_ptr = save_ptr;
754e5da2 1147
754e5da2
SG		 1148 return TCL_OK;
1149}
1150
c14cabba
AC		 1151/* Client of call_wrapper - this routine performs the actual call to
1152 the client function. */
1153
1154struct wrapped_call_args
1155{
1156 Tcl_Interp *interp;
1157 Tcl_CmdProc *func;
1158 int argc;
1159 char **argv;
1160 int val;
1161};
1162
1163static int
1164wrapped_call (args)
1165 struct wrapped_call_args *args;
1166{
1167 args->val = (*args->func) (args->func, args->interp, args->argc, args->argv);
1168 return 1;
1169}
1170
86db943c
SG		 1171/* This routine acts as a top-level for all GDB code called by tcl/Tk. It
1172 handles cleanups, and calls to return_to_top_level (usually via error).
1173 This is necessary in order to prevent a longjmp out of the bowels of Tk,
1174 possibly leaving things in a bad state. Since this routine can be called
1175 recursively, it needs to save and restore the contents of the jmp_buf as
1176 necessary. */
1177
1178static int
1179call_wrapper (clientData, interp, argc, argv)
1180 ClientData clientData;
1181 Tcl_Interp *interp;
1182 int argc;
1183 char *argv[];
1184{
c14cabba 1185 struct wrapped_call_args wrapped_args;
6131622e 1186 Tcl_DString result, *old_result_ptr;
018d76dd 1187 Tcl_DString error_string, *old_error_string_ptr;
6131622e
SG		 1188
1189 Tcl_DStringInit (&result);
1190 old_result_ptr = result_ptr;
1191 result_ptr = &result;
86db943c 1192
018d76dd
KS		 1193 Tcl_DStringInit (&error_string);
1194 old_error_string_ptr = error_string_ptr;
1195 error_string_ptr = &error_string;
1196
c14cabba
AC		 1197 wrapped_args.func = (Tcl_CmdProc *)clientData;
1198 wrapped_args.interp = interp;
1199 wrapped_args.argc = argc;
1200 wrapped_args.argv = argv;
1201 wrapped_args.val = 0;
86db943c 1202
c14cabba 1203 if (!catch_errors (wrapped_call, &wrapped_args, "", RETURN_MASK_ALL))
86db943c 1204 {
c14cabba 1205 wrapped_args.val = TCL_ERROR; /* Flag an error for TCL */
86db943c 1206
0776b0b0
MH		 1207#ifdef __CYGWIN32__
1208 /* Make sure the timer interrupts are turned off. */
1209 if (gdbtk_timer_going)
1210 gdbtk_stop_timer ();
1211#endif
86db943c 1212
0776b0b0 1213 gdb_flush (gdb_stderr); /* Flush error output */
09722039
SG		 1214 gdb_flush (gdb_stdout); /* Sometimes error output comes here as well */
1215
fda6fadc
SS		 1216 /* In case of an error, we may need to force the GUI into idle
1217 mode because gdbtk_call_command may have bombed out while in
1218 the command routine. */
86db943c 1219
40dffa42 1220 running_now = 0;
4e327047 1221 Tcl_Eval (interp, "gdbtk_tcl_idle");
86db943c 1222 }
929db6e5
EZ		 1223
1224 /* do not suppress any errors -- a remote target could have errored */
1225 load_in_progress = 0;
0776b0b0 1226
018d76dd
KS		 1227 if (Tcl_DStringLength (&error_string) == 0)
1228 {
1229 Tcl_DStringResult (interp, &result);
1230 Tcl_DStringFree (&error_string);
1231 }
1232 else if (Tcl_DStringLength (&result) == 0)
1233 {
1234 Tcl_DStringResult (interp, &error_string);
1235 Tcl_DStringFree (&result);
0776b0b0 1236 Tcl_DStringFree (&error_string);
018d76dd
KS		 1237 }
1238 else
1239 {
1240 Tcl_ResetResult (interp);
1241 Tcl_AppendResult (interp, Tcl_DStringValue (&result),
1242 Tcl_DStringValue (&error_string), (char *) NULL);
1243 Tcl_DStringFree (&result);
1244 Tcl_DStringFree (&error_string);
1245 }
1246
6131622e 1247 result_ptr = old_result_ptr;
018d76dd
KS		 1248 error_string_ptr = old_error_string_ptr;
1249
1250#ifdef _WIN32
1251 close_bfds ();
1252#endif
6131622e 1253
c14cabba 1254 return wrapped_args.val;
86db943c
SG		 1255}
1256
754e5da2 1257static int
0776b0b0
MH		 1258comp_files (file1, file2)
1259 const char *file1[], *file2[];
1260{
1261 return strcmp(*file1,*file2);
1262}
1263
0776b0b0
MH		 1264static int
1265gdb_listfiles (clientData, interp, objc, objv)
1266 ClientData clientData;
1267 Tcl_Interp *interp;
1268 int objc;
1269 Tcl_Obj *CONST objv[];
754e5da2 1270{
754e5da2
SG		 1271 struct objfile *objfile;
1272 struct partial_symtab *psymtab;
546b8ca7 1273 struct symtab *symtab;
929db6e5 1274 char *lastfile, *pathname, *files[1000];
0776b0b0
MH		 1275 int i, numfiles = 0, len = 0;
1276 Tcl_Obj *mylist;
1277
1278 if (objc > 2)
1279 {
1280 Tcl_WrongNumArgs (interp, 1, objv, "Usage: gdb_listfiles ?pathname?");
1281 return TCL_ERROR;
1282 }
1283 else if (objc == 2)
1284 pathname = Tcl_GetStringFromObj (objv[1], &len);
1285
1286 mylist = Tcl_NewListObj (0, NULL);
754e5da2
SG		 1287
1288 ALL_PSYMTABS (objfile, psymtab)
0776b0b0
MH		 1289 {
1290 if (len == 0)
1291 {
1292 if (psymtab->filename)
1293 files[numfiles++] = basename(psymtab->filename);
1294 }
1295 else if (!strcmp(psymtab->filename,basename(psymtab->filename))
1296 || !strncmp(pathname,psymtab->filename,len))
1297 if (psymtab->filename)
1298 files[numfiles++] = basename(psymtab->filename);
1299 }
754e5da2 1300
546b8ca7 1301 ALL_SYMTABS (objfile, symtab)
0776b0b0
MH		 1302 {
1303 if (len == 0)
1304 {
1305 if (symtab->filename)
1306 files[numfiles++] = basename(symtab->filename);
1307 }
1308 else if (!strcmp(symtab->filename,basename(symtab->filename))
1309 || !strncmp(pathname,symtab->filename,len))
1310 if (symtab->filename)
1311 files[numfiles++] = basename(symtab->filename);
1312 }
1313
1314 qsort (files, numfiles, sizeof(char *), comp_files);
546b8ca7 1315
0776b0b0
MH		 1316 lastfile = "";
1317 for (i = 0; i < numfiles; i++)
1318 {
1319 if (strcmp(files[i],lastfile))
1320 Tcl_ListObjAppendElement (interp, mylist, Tcl_NewStringObj(files[i], -1));
1321 lastfile = files[i];
1322 }
1323 Tcl_SetObjResult (interp, mylist);
754e5da2
SG		 1324 return TCL_OK;
1325}
479f0f18 1326
99c98415
MH		 1327static int
1328gdb_listfuncs (clientData, interp, argc, argv)
1329 ClientData clientData;
1330 Tcl_Interp *interp;
1331 int argc;
1332 char *argv[];
1333{
1334 struct symtab *symtab;
1335 struct blockvector *bv;
1336 struct block *b;
1337 struct symbol *sym;
929db6e5 1338 char buf[128];
99c98415 1339 int i,j;
929db6e5 1340
99c98415
MH		 1341 if (argc != 2)
1342 error ("wrong # args");
1343
929db6e5 1344 symtab = full_lookup_symtab (argv[1]);
99c98415
MH		 1345 if (!symtab)
1346 error ("No such file");
1347
1348 bv = BLOCKVECTOR (symtab);
1349 for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
1350 {
1351 b = BLOCKVECTOR_BLOCK (bv, i);
1352 /* Skip the sort if this block is always sorted. */
1353 if (!BLOCK_SHOULD_SORT (b))
1354 sort_block_syms (b);
1355 for (j = 0; j < BLOCK_NSYMS (b); j++)
1356 {
1357 sym = BLOCK_SYM (b, j);
1358 if (SYMBOL_CLASS (sym) == LOC_BLOCK)
1359 {
929db6e5
EZ		 1360
1361 char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
1362 if (name)
1363 {
1364 sprintf (buf,"{%s} 1", name);
1365 }
1366 else
1367 sprintf (buf,"{%s} 0", SYMBOL_NAME(sym));
1368 Tcl_DStringAppendElement (result_ptr, buf);
99c98415
MH		 1369 }
1370 }
1371 }
1372 return TCL_OK;
1373}
1374
ed5fa7c3
MH		 1375static int
1376target_stop_wrapper (args)
1377 char * args;
1378{
1379 target_stop ();
1380 return 1;
1381}
1382
479f0f18
SG		 1383static int
1384gdb_stop (clientData, interp, argc, argv)
1385 ClientData clientData;
1386 Tcl_Interp *interp;
1387 int argc;
1388 char *argv[];
1389{
c14cabba 1390 if (target_stop)
ed5fa7c3
MH		 1391 {
1392 catch_errors (target_stop_wrapper, NULL, "",
1393 RETURN_MASK_ALL);
1394 }
c14cabba
AC		 1395 else
1396 quit_flag = 1; /* hope something sees this */
546b8ca7
SG		 1397
1398 return TCL_OK;
479f0f18 1399}
018d76dd
KS		 1400
1401/* Prepare to accept a new executable file. This is called when we
1402 want to clear away everything we know about the old file, without
1403 asking the user. The Tcl code will have already asked the user if
1404 necessary. After this is called, we should be able to run the
1405 `file' command without getting any questions. */
1406
1407static int
1408gdb_clear_file (clientData, interp, argc, argv)
1409 ClientData clientData;
1410 Tcl_Interp *interp;
1411 int argc;
1412 char *argv[];
1413{
1414 if (inferior_pid != 0 && target_has_execution)
1415 {
1416 if (attach_flag)
1417 target_detach (NULL, 0);
1418 else
1419 target_kill ();
1420 }
1421
1422 if (target_has_execution)
1423 pop_target ();
1424
1425 symbol_file_command (NULL, 0);
1426
0776b0b0
MH		 1427 /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
1428 clear it here. FIXME: This seems like an abstraction violation
1429 somewhere. */
1430 stop_pc = 0;
1431
018d76dd
KS		 1432 return TCL_OK;
1433}
1434
1435/* Ask the user to confirm an exit request. */
1436
1437static int
1438gdb_confirm_quit (clientData, interp, argc, argv)
1439 ClientData clientData;
1440 Tcl_Interp *interp;
1441 int argc;
1442 char *argv[];
1443{
1444 int ret;
1445
1446 ret = quit_confirm ();
1447 Tcl_DStringAppendElement (result_ptr, ret ? "1" : "0");
1448 return TCL_OK;
1449}
1450
1451/* Quit without asking for confirmation. */
1452
1453static int
1454gdb_force_quit (clientData, interp, argc, argv)
1455 ClientData clientData;
1456 Tcl_Interp *interp;
1457 int argc;
1458 char *argv[];
1459{
1460 quit_force ((char *) NULL, 1);
1461 return TCL_OK;
1462}
09722039
SG		 1463\f
1464/* This implements the TCL command `gdb_disassemble'. */
479f0f18 1465
09722039
SG		 1466static int
1467gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
1468 bfd_vma memaddr;
1469 bfd_byte *myaddr;
1470 int len;
1471 disassemble_info *info;
1472{
1473 extern struct target_ops exec_ops;
1474 int res;
1475
1476 errno = 0;
1477 res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
1478
1479 if (res == len)
1480 return 0;
1481 else
1482 if (errno == 0)
1483 return EIO;
1484 else
1485 return errno;
1486}
1487
1488/* We need a different sort of line table from the normal one cuz we can't
1489 depend upon implicit line-end pc's for lines. This is because of the
1490 reordering we are about to do. */
1491
1492struct my_line_entry {
1493 int line;
1494 CORE_ADDR start_pc;
1495 CORE_ADDR end_pc;
1496};
1497
1498static int
1499compare_lines (mle1p, mle2p)
1500 const PTR mle1p;
1501 const PTR mle2p;
1502{
1503 struct my_line_entry *mle1, *mle2;
1504 int val;
1505
1506 mle1 = (struct my_line_entry *) mle1p;
1507 mle2 = (struct my_line_entry *) mle2p;
1508
1509 val = mle1->line - mle2->line;
1510
1511 if (val != 0)
1512 return val;
1513
1514 return mle1->start_pc - mle2->start_pc;
1515}
1516
1517static int
1518gdb_disassemble (clientData, interp, argc, argv)
1519 ClientData clientData;
1520 Tcl_Interp *interp;
1521 int argc;
1522 char *argv[];
1523{
1524 CORE_ADDR pc, low, high;
1525 int mixed_source_and_assembly;
fc941258
DE		 1526 static disassemble_info di;
1527 static int di_initialized;
1528
1529 if (! di_initialized)
1530 {
91550191
SG		 1531 INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
1532 (fprintf_ftype) fprintf_unfiltered);
caeec767 1533 di.flavour = bfd_target_unknown_flavour;
fc941258
DE		 1534 di.memory_error_func = dis_asm_memory_error;
1535 di.print_address_func = dis_asm_print_address;
1536 di_initialized = 1;
1537 }
09722039 1538
91550191
SG		 1539 di.mach = tm_print_insn_info.mach;
1540 if (TARGET_BYTE_ORDER == BIG_ENDIAN)
e4bb9027 1541 di.endian = BFD_ENDIAN_BIG;
91550191 1542 else
e4bb9027 1543 di.endian = BFD_ENDIAN_LITTLE;
91550191 1544
09722039 1545 if (argc != 3 && argc != 4)
6131622e 1546 error ("wrong # args");
09722039
SG		 1547
1548 if (strcmp (argv[1], "source") == 0)
1549 mixed_source_and_assembly = 1;
1550 else if (strcmp (argv[1], "nosource") == 0)
1551 mixed_source_and_assembly = 0;
1552 else
6131622e 1553 error ("First arg must be 'source' or 'nosource'");
09722039
SG		 1554
1555 low = parse_and_eval_address (argv[2]);
1556
1557 if (argc == 3)
1558 {
1559 if (find_pc_partial_function (low, NULL, &low, &high) == 0)
6131622e 1560 error ("No function contains specified address");
09722039
SG		 1561 }
1562 else
1563 high = parse_and_eval_address (argv[3]);
1564
1565 /* If disassemble_from_exec == -1, then we use the following heuristic to
1566 determine whether or not to do disassembly from target memory or from the
1567 exec file:
1568
1569 If we're debugging a local process, read target memory, instead of the
1570 exec file. This makes disassembly of functions in shared libs work
1571 correctly.
1572
1573 Else, we're debugging a remote process, and should disassemble from the
fda6fadc 1574 exec file for speed. However, this is no good if the target modifies its
09722039
SG		 1575 code (for relocation, or whatever).
1576 */
1577
1578 if (disassemble_from_exec == -1)
1579 if (strcmp (target_shortname, "child") == 0
d7c4766c
SS		 1580 || strcmp (target_shortname, "procfs") == 0
1581 || strcmp (target_shortname, "vxprocess") == 0)
09722039
SG		 1582 disassemble_from_exec = 0; /* It's a child process, read inferior mem */
1583 else
1584 disassemble_from_exec = 1; /* It's remote, read the exec file */
1585
1586 if (disassemble_from_exec)
a76ef70a
SG		 1587 di.read_memory_func = gdbtk_dis_asm_read_memory;
1588 else
1589 di.read_memory_func = dis_asm_read_memory;
09722039
SG		 1590
1591 /* If just doing straight assembly, all we need to do is disassemble
1592 everything between low and high. If doing mixed source/assembly, we've
1593 got a totally different path to follow. */
1594
1595 if (mixed_source_and_assembly)
1596 { /* Come here for mixed source/assembly */
1597 /* The idea here is to present a source-O-centric view of a function to
1598 the user. This means that things are presented in source order, with
1599 (possibly) out of order assembly immediately following. */
1600 struct symtab *symtab;
1601 struct linetable_entry *le;
1602 int nlines;
c81a3fa9 1603 int newlines;
09722039
SG		 1604 struct my_line_entry *mle;
1605 struct symtab_and_line sal;
1606 int i;
1607 int out_of_order;
c81a3fa9 1608 int next_line;
09722039
SG		 1609
1610 symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
1611
1612 if (!symtab)
1613 goto assembly_only;
1614
1615/* First, convert the linetable to a bunch of my_line_entry's. */
1616
1617 le = symtab->linetable->item;
1618 nlines = symtab->linetable->nitems;
1619
1620 if (nlines <= 0)
1621 goto assembly_only;
1622
1623 mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
1624
1625 out_of_order = 0;
1626
c81a3fa9
SG		 1627/* Copy linetable entries for this function into our data structure, creating
1628 end_pc's and setting out_of_order as appropriate. */
1629
1630/* First, skip all the preceding functions. */
1631
1632 for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
1633
1634/* Now, copy all entries before the end of this function. */
1635
1636 newlines = 0;
1637 for (; i < nlines - 1 && le[i].pc < high; i++)
09722039 1638 {
c81a3fa9
SG		 1639 if (le[i].line == le[i + 1].line
1640 && le[i].pc == le[i + 1].pc)
1641 continue; /* Ignore duplicates */
1642
1643 mle[newlines].line = le[i].line;
09722039
SG		 1644 if (le[i].line > le[i + 1].line)
1645 out_of_order = 1;
c81a3fa9
SG		 1646 mle[newlines].start_pc = le[i].pc;
1647 mle[newlines].end_pc = le[i + 1].pc;
1648 newlines++;
09722039
SG		 1649 }
1650
c81a3fa9
SG		 1651/* If we're on the last line, and it's part of the function, then we need to
1652 get the end pc in a special way. */
1653
1654 if (i == nlines - 1
1655 && le[i].pc < high)
1656 {
1657 mle[newlines].line = le[i].line;
1658 mle[newlines].start_pc = le[i].pc;
1659 sal = find_pc_line (le[i].pc, 0);
1660 mle[newlines].end_pc = sal.end;
1661 newlines++;
1662 }
09722039
SG		 1663
1664/* Now, sort mle by line #s (and, then by addresses within lines). */
1665
1666 if (out_of_order)
c81a3fa9 1667 qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
09722039
SG		 1668
1669/* Now, for each line entry, emit the specified lines (unless they have been
1670 emitted before), followed by the assembly code for that line. */
1671
c81a3fa9
SG		 1672 next_line = 0; /* Force out first line */
1673 for (i = 0; i < newlines; i++)
09722039 1674 {
c81a3fa9
SG		 1675/* Print out everything from next_line to the current line. */
1676
1677 if (mle[i].line >= next_line)
09722039 1678 {
c81a3fa9
SG		 1679 if (next_line != 0)
1680 print_source_lines (symtab, next_line, mle[i].line + 1, 0);
09722039 1681 else
c81a3fa9
SG		 1682 print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
1683
1684 next_line = mle[i].line + 1;
09722039 1685 }
c81a3fa9 1686
09722039
SG		 1687 for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
1688 {
1689 QUIT;
1690 fputs_unfiltered (" ", gdb_stdout);
1691 print_address (pc, gdb_stdout);
1692 fputs_unfiltered (":\t ", gdb_stdout);
d039851f 1693 pc += (*tm_print_insn) (pc, &di);
09722039
SG		 1694 fputs_unfiltered ("\n", gdb_stdout);
1695 }
1696 }
1697 }
1698 else
1699 {
1700assembly_only:
1701 for (pc = low; pc < high; )
1702 {
1703 QUIT;
1704 fputs_unfiltered (" ", gdb_stdout);
1705 print_address (pc, gdb_stdout);
1706 fputs_unfiltered (":\t ", gdb_stdout);
d039851f 1707 pc += (*tm_print_insn) (pc, &di);
09722039
SG		 1708 fputs_unfiltered ("\n", gdb_stdout);
1709 }
1710 }
1711
09722039
SG		 1712 gdb_flush (gdb_stdout);
1713
1714 return TCL_OK;
1715}
754e5da2
SG		 1716\f
1717static void
1718tk_command (cmd, from_tty)
1719 char *cmd;
1720 int from_tty;
1721{
546b8ca7
SG		 1722 int retval;
1723 char *result;
1724 struct cleanup *old_chain;
1725
572977a5
FF		 1726 /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1727 if (cmd == NULL)
1728 error_no_arg ("tcl command to interpret");
1729
546b8ca7
SG		 1730 retval = Tcl_Eval (interp, cmd);
1731
1732 result = strdup (interp->result);
754e5da2 1733
546b8ca7
SG		 1734 old_chain = make_cleanup (free, result);
1735
1736 if (retval != TCL_OK)
1737 error (result);
1738
1739 printf_unfiltered ("%s\n", result);
1740
1741 do_cleanups (old_chain);
754e5da2
SG		 1742}
1743
1744static void
1745cleanup_init (ignored)
1746 int ignored;
1747{
754e5da2
SG		 1748 if (interp != NULL)
1749 Tcl_DeleteInterp (interp);
1750 interp = NULL;
1751}
1752
637b1661
SG		 1753/* Come here during long calculations to check for GUI events. Usually invoked
1754 via the QUIT macro. */
1755
1756static void
1757gdbtk_interactive ()
1758{
1759 /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1760}
1761
479f0f18
SG		 1762/* Come here when there is activity on the X file descriptor. */
1763
1764static void
1765x_event (signo)
1766 int signo;
1767{
ed5fa7c3
MH		 1768 static int in_x_event = 0;
1769 static Tcl_Obj *varname = NULL;
1770
1771 if (in_x_event || in_fputs)
1772 return;
1773
1774 in_x_event = 1;
1775
479f0f18 1776 /* Process pending events */
0776b0b0
MH		 1777 while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
1778 ;
1779
0776b0b0
MH		 1780 if (load_in_progress)
1781 {
ed5fa7c3
MH		 1782 int val;
1783 if (varname == NULL)
1784 {
1785 Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
1786 varname = Tcl_ObjGetVar2(interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
1787 }
1788 if ((Tcl_GetIntFromObj(interp,varname,&val) == TCL_OK) && val)
0776b0b0
MH		 1789 {
1790 quit_flag = 1;
1791#ifdef REQUEST_QUIT
1792 REQUEST_QUIT;
1793#else
1794 if (immediate_quit)
1795 quit ();
1796#endif
1797 }
1798 }
ed5fa7c3 1799 in_x_event = 0;
479f0f18
SG		 1800}
1801
018d76dd
KS		 1802#ifdef __CYGWIN32__
1803
1804/* For Cygwin32, we use a timer to periodically check for Windows
1805 messages. FIXME: It would be better to not poll, but to instead
1806 rewrite the target_wait routines to serve as input sources.
1807 Unfortunately, that will be a lot of work. */
ed5fa7c3
MH		 1808static sigset_t nullsigmask;
1809static struct sigaction act1, act2;
1810static struct itimerval it_on, it_off;
018d76dd
KS		 1811
1812static void
1813gdbtk_start_timer ()
1814{
ed5fa7c3
MH		 1815 static int first = 1;
1816 /*TclDebug ("Starting timer....");*/
1817 if (first)
1818 {
1819 /* first time called, set up all the structs */
1820 first = 0;
1821 sigemptyset (&nullsigmask);
018d76dd 1822
ed5fa7c3
MH		 1823 act1.sa_handler = x_event;
1824 act1.sa_mask = nullsigmask;
1825 act1.sa_flags = 0;
018d76dd 1826
ed5fa7c3
MH		 1827 act2.sa_handler = SIG_IGN;
1828 act2.sa_mask = nullsigmask;
1829 act2.sa_flags = 0;
018d76dd 1830
ed5fa7c3
MH		 1831 it_on.it_interval.tv_sec = 0;
1832 it_on.it_interval.tv_usec = 500000; /* .5 sec */
1833 it_on.it_value.tv_sec = 0;
1834 it_on.it_value.tv_usec = 500000;
0776b0b0 1835
ed5fa7c3
MH		 1836 it_off.it_interval.tv_sec = 0;
1837 it_off.it_interval.tv_usec = 0;
1838 it_off.it_value.tv_sec = 0;
1839 it_off.it_value.tv_usec = 0;
1840 }
1841 sigaction (SIGALRM, &act1, NULL);
1842 setitimer (ITIMER_REAL, &it_on, NULL);
0776b0b0 1843 gdbtk_timer_going = 1;
018d76dd
KS		 1844}
1845
1846static void
1847gdbtk_stop_timer ()
1848{
0776b0b0 1849 gdbtk_timer_going = 0;
929db6e5 1850 /*TclDebug ("Stopping timer.");*/
ed5fa7c3
MH		 1851 setitimer (ITIMER_REAL, &it_off, NULL);
1852 sigaction (SIGALRM, &act2, NULL);
018d76dd
KS		 1853}
1854
1855#endif
1856
1857/* This hook function is called whenever we want to wait for the
1858 target. */
1859
479f0f18
SG		 1860static int
1861gdbtk_wait (pid, ourstatus)
1862 int pid;
1863 struct target_waitstatus *ourstatus;
1864{
018d76dd 1865#ifndef WINNT
736a82e7
SG		 1866 struct sigaction action;
1867 static sigset_t nullsigmask = {0};
1868
018d76dd 1869
736a82e7
SG		 1870#ifndef SA_RESTART
1871 /* Needed for SunOS 4.1.x */
1872#define SA_RESTART 0
546b8ca7 1873#endif
479f0f18 1874
736a82e7
SG		 1875 action.sa_handler = x_event;
1876 action.sa_mask = nullsigmask;
1877 action.sa_flags = SA_RESTART;
1878 sigaction(SIGIO, &action, NULL);
018d76dd
KS		 1879#endif /* WINNT */
1880
479f0f18
SG		 1881 pid = target_wait (pid, ourstatus);
1882
8a19b35a 1883#ifndef WINNT
018d76dd 1884 action.sa_handler = SIG_IGN;
8a19b35a
MH		 1885 sigaction(SIGIO, &action, NULL);
1886#endif
479f0f18
SG		 1887
1888 return pid;
1889}
1890
1891/* This is called from execute_command, and provides a wrapper around
1892 various command routines in a place where both protocol messages and
1893 user input both flow through. Mostly this is used for indicating whether
1894 the target process is running or not.
1895*/
1896
1897static void
1898gdbtk_call_command (cmdblk, arg, from_tty)
1899 struct cmd_list_element *cmdblk;
1900 char *arg;
1901 int from_tty;
1902{
fda6fadc 1903 running_now = 0;
018d76dd 1904 if (cmdblk->class == class_run || cmdblk->class == class_trace)
479f0f18 1905 {
fda6fadc 1906 running_now = 1;
4e327047 1907 Tcl_Eval (interp, "gdbtk_tcl_busy");
479f0f18 1908 (*cmdblk->function.cfunc)(arg, from_tty);
fda6fadc 1909 running_now = 0;
2476848a 1910 Tcl_Eval (interp, "gdbtk_tcl_idle");
479f0f18
SG		 1911 }
1912 else
1913 (*cmdblk->function.cfunc)(arg, from_tty);
1914}
1915
5bac2b50
FF		 1916/* This function is called instead of gdb's internal command loop. This is the
1917 last chance to do anything before entering the main Tk event loop. */
1918
1919static void
1920tk_command_loop ()
1921{
41756e56
FF		 1922 extern GDB_FILE *instream;
1923
1924 /* We no longer want to use stdin as the command input stream */
1925 instream = NULL;
018d76dd
KS		 1926
1927 if (Tcl_Eval (interp, "gdbtk_tcl_preloop") != TCL_OK)
1928 {
1929 char *msg;
1930
1931 /* Force errorInfo to be set up propertly. */
1932 Tcl_AddErrorInfo (interp, "");
1933
1934 msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
1935#ifdef _WIN32
1936 MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
1937#else
1938 fputs_unfiltered (msg, gdb_stderr);
1939#endif
1940 }
1941
1942#ifdef _WIN32
1943 close_bfds ();
1944#endif
1945
5bac2b50
FF		 1946 Tk_MainLoop ();
1947}
1948
9a2f9219
ILT		 1949/* gdbtk_init installs this function as a final cleanup. */
1950
1951static void
1952gdbtk_cleanup (dummy)
1953 PTR dummy;
1954{
929db6e5
EZ		 1955#ifdef IDE
1956 struct ide_event_handle *h = (struct ide_event_handle *) dummy;
1957
1958 ide_interface_deregister_all (h);
1959#endif
9a2f9219
ILT		 1960 Tcl_Finalize ();
1961}
1962
1963/* Initialize gdbtk. */
1964
754e5da2 1965static void
2476848a
MH		 1966gdbtk_init ( argv0 )
1967 char *argv0;
754e5da2
SG		 1968{
1969 struct cleanup *old_chain;
74089546 1970 char *lib, *gdbtk_lib, *gdbtk_lib_tmp, *gdbtk_file;
8a19b35a 1971 int i, found_main;
018d76dd 1972#ifndef WINNT
736a82e7
SG		 1973 struct sigaction action;
1974 static sigset_t nullsigmask = {0};
018d76dd 1975#endif
2476848a 1976#ifdef IDE
018d76dd 1977 /* start-sanitize-ide */
2476848a
MH		 1978 struct ide_event_handle *h;
1979 const char *errmsg;
1980 char *libexecdir;
018d76dd 1981 /* end-sanitize-ide */
2476848a 1982#endif
754e5da2 1983
fe58c81f
FF		 1984 /* If there is no DISPLAY environment variable, Tk_Init below will fail,
1985 causing gdb to abort. If instead we simply return here, gdb will
1986 gracefully degrade to using the command line interface. */
1987
8a19b35a 1988#ifndef WINNT
fe58c81f
FF		 1989 if (getenv ("DISPLAY") == NULL)
1990 return;
8a19b35a 1991#endif
fe58c81f 1992
754e5da2
SG		 1993 old_chain = make_cleanup (cleanup_init, 0);
1994
1995 /* First init tcl and tk. */
2476848a 1996 Tcl_FindExecutable (argv0);
754e5da2
SG		 1997 interp = Tcl_CreateInterp ();
1998
ed5fa7c3
MH		 1999#ifdef TCL_MEM_DEBUG
2000 Tcl_InitMemory (interp);
2001#endif
2002
754e5da2
SG		 2003 if (!interp)
2004 error ("Tcl_CreateInterp failed");
2005
754e5da2
SG		 2006 if (Tcl_Init(interp) != TCL_OK)
2007 error ("Tcl_Init failed: %s", interp->result);
2008
929db6e5
EZ		 2009#ifndef IDE
2010 /* For the IDE we register the cleanup later, after we've
2011 initialized events. */
2012 make_final_cleanup (gdbtk_cleanup, NULL);
2013#endif
2476848a 2014
9a2f9219 2015 /* Initialize the Paths variable. */
74089546 2016 if (ide_initialize_paths (interp, "gdbtcl") != TCL_OK)
9a2f9219
ILT		 2017 error ("ide_initialize_paths failed: %s", interp->result);
2018
dd3dd918 2019#ifdef IDE
018d76dd 2020 /* start-sanitize-ide */
2476848a
MH		 2021 /* Find the directory where we expect to find idemanager. We ignore
2022 errors since it doesn't really matter if this fails. */
2023 libexecdir = Tcl_GetVar2 (interp, "Paths", "libexecdir", TCL_GLOBAL_ONLY);
2024
2025 IluTk_Init ();
2026
7b94b2ea 2027 h = ide_event_init_from_environment (&errmsg, libexecdir);
929db6e5 2028 make_final_cleanup (gdbtk_cleanup, h);
2476848a
MH		 2029 if (h == NULL)
2030 {
2031 Tcl_AppendResult (interp, "can't initialize event system: ", errmsg,
2032 (char *) NULL);
2033 fprintf(stderr, "WARNING: ide_event_init_client failed: %s\n", interp->result);
9a2f9219
ILT		 2034
2035 Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
2476848a
MH		 2036 }
2037 else
2038 {
2039 if (ide_create_tclevent_command (interp, h) != TCL_OK)
2040 error ("ide_create_tclevent_command failed: %s", interp->result);
018d76dd 2041
2476848a
MH		 2042 if (ide_create_edit_command (interp, h) != TCL_OK)
2043 error ("ide_create_edit_command failed: %s", interp->result);
2044
2045 if (ide_create_property_command (interp, h) != TCL_OK)
2046 error ("ide_create_property_command failed: %s", interp->result);
018d76dd
KS		 2047
2048 if (ide_create_build_command (interp, h) != TCL_OK)
2049 error ("ide_create_build_command failed: %s", interp->result);
2050
2051 if (ide_create_window_register_command (interp, h, "gdb-restore")
2052 != TCL_OK)
9a2f9219
ILT		 2053 error ("ide_create_window_register_command failed: %s",
2054 interp->result);
2055
2056 if (ide_create_window_command (interp, h) != TCL_OK)
2057 error ("ide_create_window_command failed: %s", interp->result);
2058
018d76dd
KS		 2059 if (ide_create_exit_command (interp, h) != TCL_OK)
2060 error ("ide_create_exit_command failed: %s", interp->result);
2061
2062 if (ide_create_help_command (interp) != TCL_OK)
2063 error ("ide_create_help_command failed: %s", interp->result);
2064
2476848a
MH		 2065 /*
2066 if (ide_initialize (interp, "gdb") != TCL_OK)
2067 error ("ide_initialize failed: %s", interp->result);
2068 */
9a2f9219
ILT		 2069
2070 Tcl_SetVar (interp, "GDBTK_IDE", "1", 0);
018d76dd 2071 Tcl_SetVar (interp, "IDE", "1", TCL_GLOBAL_ONLY);
2476848a 2072 }
018d76dd 2073 /* end-sanitize-ide */
2476848a
MH		 2074#else
2075 Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
2076#endif /* IDE */
2077
9a2f9219
ILT		 2078 /* We don't want to open the X connection until we've done all the
2079 IDE initialization. Otherwise, goofy looking unfinished windows
2080 pop up when ILU drops into the TCL event loop. */
2081
2082 if (Tk_Init(interp) != TCL_OK)
2083 error ("Tk_Init failed: %s", interp->result);
2084
2085 if (Itcl_Init(interp) == TCL_ERROR)
2086 error ("Itcl_Init failed: %s", interp->result);
2087
2088 if (Tix_Init(interp) != TCL_OK)
2089 error ("Tix_Init failed: %s", interp->result);
2090
018d76dd 2091#ifdef __CYGWIN32__
929db6e5
EZ		 2092 if (ide_create_messagebox_command (interp) != TCL_OK)
2093 error ("messagebox command initialization failed");
018d76dd
KS		 2094 /* On Windows, create a sizebox widget command */
2095 if (ide_create_sizebox_command (interp) != TCL_OK)
2096 error ("sizebox creation failed");
2097 if (ide_create_winprint_command (interp) != TCL_OK)
2098 error ("windows print code initialization failed");
2099 /* start-sanitize-ide */
2100 /* An interface to ShellExecute. */
2101 if (ide_create_shell_execute_command (interp) != TCL_OK)
2102 error ("shell execute command initialization failed");
06434f5f 2103 /* end-sanitize-ide */
929db6e5
EZ		 2104 if (ide_create_win_grab_command (interp) != TCL_OK)
2105 error ("grab support command initialization failed");
2106 /* Path conversion functions. */
2107 if (ide_create_cygwin_path_command (interp) != TCL_OK)
2108 error ("cygwin path command initialization failed");
018d76dd
KS		 2109#endif
2110
86db943c 2111 Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
0422b59e
KS		 2112 Tcl_CreateCommand (interp, "gdb_immediate", call_wrapper,
2113 gdb_immediate_command, NULL);
86db943c 2114 Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
8a19b35a 2115 Tcl_CreateCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
0776b0b0 2116 Tcl_CreateObjCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
99c98415
MH		 2117 Tcl_CreateCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
2118 NULL);
018d76dd
KS		 2119 Tcl_CreateCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
2120 NULL);
86db943c
SG		 2121 Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
2122 Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
2123 Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
2124 gdb_fetch_registers, NULL);
2125 Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
2126 gdb_changed_register_list, NULL);
09722039
SG		 2127 Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
2128 gdb_disassemble, NULL);
2129 Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
6131622e
SG		 2130 Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
2131 gdb_get_breakpoint_list, NULL);
2132 Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
2133 gdb_get_breakpoint_info, NULL);
018d76dd
KS		 2134 Tcl_CreateCommand (interp, "gdb_clear_file", call_wrapper,
2135 gdb_clear_file, NULL);
2136 Tcl_CreateCommand (interp, "gdb_confirm_quit", call_wrapper,
2137 gdb_confirm_quit, NULL);
2138 Tcl_CreateCommand (interp, "gdb_force_quit", call_wrapper,
2139 gdb_force_quit, NULL);
2140 Tcl_CreateCommand (interp, "gdb_target_has_execution",
2141 gdb_target_has_execution_command,
2142 NULL, NULL);
41158958
EZ		 2143 Tcl_CreateCommand (interp, "gdb_is_tracing",
2144 gdb_trace_status,
2145 NULL, NULL);
018d76dd
KS		 2146 Tcl_CreateObjCommand (interp, "gdb_load_info", gdb_load_info, NULL, NULL);
2147 Tcl_CreateObjCommand (interp, "gdb_get_locals", gdb_get_vars_command,
2148 (ClientData) 0, NULL);
2149 Tcl_CreateObjCommand (interp, "gdb_get_args", gdb_get_vars_command,
2150 (ClientData) 1, NULL);
2151 Tcl_CreateObjCommand (interp, "gdb_get_function", gdb_get_function_command,
2152 NULL, NULL);
2153 Tcl_CreateObjCommand (interp, "gdb_get_line", gdb_get_line_command,
2154 NULL, NULL);
2155 Tcl_CreateObjCommand (interp, "gdb_get_file", gdb_get_file_command,
2156 NULL, NULL);
2157 Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
2158 gdb_tracepoint_exists_command, NULL, NULL);
2159 Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
2160 gdb_get_tracepoint_info, NULL, NULL);
2161 Tcl_CreateObjCommand (interp, "gdb_actions",
2162 gdb_actions_command, NULL, NULL);
2163 Tcl_CreateObjCommand (interp, "gdb_prompt",
2164 gdb_prompt_command, NULL, NULL);
e0f7db02
KS		 2165 Tcl_CreateObjCommand (interp, "gdb_find_file",
2166 gdb_find_file_command, NULL, NULL);
4f17e6eb 2167 Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
929db6e5
EZ		 2168 gdb_get_tracepoint_list, NULL, NULL);
2169 Tcl_CreateCommand (interp, "gdb_pc_reg", get_pc_register, NULL, NULL);
2170 Tcl_CreateObjCommand (interp, "gdb_loadfile", gdb_loadfile, NULL, NULL);
2171 Tcl_CreateObjCommand (interp, "gdb_set_bp", gdb_set_bp, NULL, NULL);
2172
5bac2b50 2173 command_loop_hook = tk_command_loop;
a5f4fbff 2174 print_frame_info_listing_hook = gdbtk_print_frame_info;
09722039
SG		 2175 query_hook = gdbtk_query;
2176 flush_hook = gdbtk_flush;
2177 create_breakpoint_hook = gdbtk_create_breakpoint;
2178 delete_breakpoint_hook = gdbtk_delete_breakpoint;
6131622e 2179 modify_breakpoint_hook = gdbtk_modify_breakpoint;
09722039
SG		 2180 interactive_hook = gdbtk_interactive;
2181 target_wait_hook = gdbtk_wait;
2182 call_command_hook = gdbtk_call_command;
41756e56
FF		 2183 readline_begin_hook = gdbtk_readline_begin;
2184 readline_hook = gdbtk_readline;
2185 readline_end_hook = gdbtk_readline_end;
018d76dd 2186 ui_load_progress_hook = gdbtk_load_hash;
11f91b2b
KS		 2187 pre_add_symbol_hook = gdbtk_pre_add_symbol;
2188 post_add_symbol_hook = gdbtk_post_add_symbol;
018d76dd
KS		 2189 create_tracepoint_hook = gdbtk_create_tracepoint;
2190 delete_tracepoint_hook = gdbtk_delete_tracepoint;
a5f4fbff 2191 modify_tracepoint_hook = gdbtk_modify_tracepoint;
929db6e5
EZ		 2192 pc_changed_hook = pc_changed;
2193#ifdef __CYGWIN32__
2194 annotate_starting_hook = gdbtk_annotate_starting;
2195 annotate_stopped_hook = gdbtk_annotate_stopped;
2196 annotate_signalled_hook = gdbtk_annotate_signalled;
2197 annotate_exited_hook = gdbtk_annotate_exited;
2198 ui_loop_hook = x_event;
2199#endif
018d76dd 2200#ifndef WINNT
cd2df226 2201 /* Get the file descriptor for the X server */
479f0f18 2202
047465fd 2203 x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
479f0f18
SG		 2204
2205 /* Setup for I/O interrupts */
2206
736a82e7
SG		 2207 action.sa_mask = nullsigmask;
2208 action.sa_flags = 0;
2209 action.sa_handler = SIG_IGN;
2210 sigaction(SIGIO, &action, NULL);
2211
2212#ifdef FIOASYNC
2213 i = 1;
2214 if (ioctl (x_fd, FIOASYNC, &i))
2215 perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
479f0f18 2216
77a89957 2217#ifdef SIOCSPGRP
736a82e7
SG		 2218 i = getpid();
2219 if (ioctl (x_fd, SIOCSPGRP, &i))
2220 perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
45f90c50
MM		 2221
2222#else
2223#ifdef F_SETOWN
2224 i = getpid();
2225 if (fcntl (x_fd, F_SETOWN, i))
2226 perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
2227#endif /* F_SETOWN */
2228#endif /* !SIOCSPGRP */
546b8ca7 2229#else
8a19b35a 2230#ifndef WINNT
546b8ca7 2231 if (ioctl (x_fd, I_SETSIG, S_INPUT|S_RDNORM) < 0)
736a82e7 2232 perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
8a19b35a
MH		 2233#endif
2234
736a82e7 2235#endif /* ifndef FIOASYNC */
018d76dd 2236#endif /* WINNT */
479f0f18 2237
754e5da2
SG		 2238 add_com ("tk", class_obscure, tk_command,
2239 "Send a command directly into tk.");
09722039 2240
09722039
SG		 2241 Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
2242 TCL_LINK_INT);
2243
8a19b35a 2244 /* find the gdb tcl library and source main.tcl */
09722039 2245
8a19b35a
MH		 2246 gdbtk_lib = getenv ("GDBTK_LIBRARY");
2247 if (!gdbtk_lib)
2248 if (access ("gdbtcl/main.tcl", R_OK) == 0)
2249 gdbtk_lib = "gdbtcl";
09722039 2250 else
8a19b35a
MH		 2251 gdbtk_lib = GDBTK_LIBRARY;
2252
74089546
ILT		 2253 gdbtk_lib_tmp = xstrdup (gdbtk_lib);
2254
8a19b35a
MH		 2255 found_main = 0;
2256 /* see if GDBTK_LIBRARY is a path list */
2257 lib = strtok (gdbtk_lib_tmp, GDBTK_PATH_SEP);
2258 do
2259 {
2260 if (Tcl_VarEval (interp, "lappend auto_path ", lib, NULL) != TCL_OK)
2261 {
2262 fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
2263 error ("");
2264 }
2265 if (!found_main)
2266 {
74089546 2267 gdbtk_file = concat (lib, "/main.tcl", (char *) NULL);
8a19b35a
MH		 2268 if (access (gdbtk_file, R_OK) == 0)
2269 {
2270 found_main++;
2271 Tcl_SetVar (interp, "GDBTK_LIBRARY", lib, 0);
2272 }
2273 }
2274 }
56e327b3 2275 while ((lib = strtok (NULL, ":")) != NULL);
74089546
ILT		 2276
2277 free (gdbtk_lib_tmp);
2278
74089546
ILT		 2279 if (!found_main)
2280 {
2281 /* Try finding it with the auto path. */
2282
2283 static const char script[] ="\
2284proc gdbtk_find_main {} {\n\
2285 global auto_path GDBTK_LIBRARY\n\
2286 foreach dir $auto_path {\n\
2287 set f [file join $dir main.tcl]\n\
2288 if {[file exists $f]} then {\n\
2289 set GDBTK_LIBRARY $dir\n\
2290 return $f\n\
2291 }\n\
2292 }\n\
2293 return ""\n\
2294}\n\
2295gdbtk_find_main";
2296
2297 if (Tcl_GlobalEval (interp, (char *) script) != TCL_OK)
2298 {
2299 fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
2300 error ("");
2301 }
2302
2303 if (interp->result[0] != '\0')
2304 {
2305 gdbtk_file = xstrdup (interp->result);
2306 found_main++;
2307 }
2308 }
74089546 2309
8a19b35a
MH		 2310 if (!found_main)
2311 {
2312 fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
2313 if (getenv("GDBTK_LIBRARY"))
2314 {
2315 fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
2316 fprintf_unfiltered (stderr,
2317 "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
2318 }
2319 else
2320 {
2321 fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY);
2322 fprintf_unfiltered (stderr, "You might want to set GDBTK_LIBRARY\n");
2323 }
2324 error("");
2325 }
09722039 2326
724498fd
SG		 2327/* Defer setup of fputs_unfiltered_hook to near the end so that error messages
2328 prior to this point go to stdout/stderr. */
2329
2330 fputs_unfiltered_hook = gdbtk_fputs;
2331
8a19b35a 2332 if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK)
724498fd 2333 {
018d76dd
KS		 2334 char *msg;
2335
2336 /* Force errorInfo to be set up propertly. */
2337 Tcl_AddErrorInfo (interp, "");
2338
2339 msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
2340
724498fd
SG		 2341 fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
2342
018d76dd
KS		 2343#ifdef _WIN32
2344 MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
2345#else
2346 fputs_unfiltered (msg, gdb_stderr);
2347#endif
b66051ec 2348
b66051ec 2349 error ("");
724498fd 2350 }
09722039 2351
018d76dd
KS		 2352#ifdef IDE
2353 /* start-sanitize-ide */
2354 /* Don't do this until we have initialized. Otherwise, we may get a
2355 run command before we are ready for one. */
2356 if (ide_run_server_init (interp, h) != TCL_OK)
2357 error ("ide_run_server_init failed: %s", interp->result);
2358 /* end-sanitize-ide */
2359#endif
2360
74089546
ILT		 2361 free (gdbtk_file);
2362
09722039 2363 discard_cleanups (old_chain);
754e5da2
SG		 2364}
2365
018d76dd
KS		 2366static int
2367gdb_target_has_execution_command (clientData, interp, argc, argv)
2368 ClientData clientData;
2369 Tcl_Interp *interp;
2370 int argc;
2371 char *argv[];
2372{
2373 int result = 0;
2374
2375 if (target_has_execution && inferior_pid != 0)
2376 result = 1;
2377
2378 Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
2379 return TCL_OK;
2380}
2381
41158958
EZ		 2382static int
2383gdb_trace_status (clientData, interp, argc, argv)
2384 ClientData clientData;
2385 Tcl_Interp *interp;
2386 int argc;
2387 char *argv[];
2388{
2389 int result = 0;
2390
2391 if (trace_running_p)
2392 result = 1;
2393
2394 Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
2395 return TCL_OK;
2396}
2397
018d76dd
KS		 2398/* gdb_load_info - returns information about the file about to be downloaded */
2399
2400static int
2401gdb_load_info (clientData, interp, objc, objv)
2402 ClientData clientData;
2403 Tcl_Interp *interp;
2404 int objc;
2405 Tcl_Obj *CONST objv[];
2406{
2407 bfd *loadfile_bfd;
2408 struct cleanup *old_cleanups;
2409 asection *s;
2410 Tcl_Obj *ob[2];
2411 Tcl_Obj *res[16];
2412 int i = 0;
2413
2414 char *filename = Tcl_GetStringFromObj (objv[1], NULL);
2415
2416 loadfile_bfd = bfd_openr (filename, gnutarget);
2417 if (loadfile_bfd == NULL)
2418 {
2419 Tcl_SetObjResult (interp, Tcl_NewStringObj ("Open failed", -1));
2420 return TCL_ERROR;
2421 }
2422 old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
2423
2424 if (!bfd_check_format (loadfile_bfd, bfd_object))
2425 {
2426 Tcl_SetObjResult (interp, Tcl_NewStringObj ("Bad Object File", -1));
2427 return TCL_ERROR;
2428 }
2429
2430 for (s = loadfile_bfd->sections; s; s = s->next)
2431 {
2432 if (s->flags & SEC_LOAD)
2433 {
2434 bfd_size_type size = bfd_get_section_size_before_reloc (s);
2435 if (size > 0)
2436 {
2437 ob[0] = Tcl_NewStringObj((char *)bfd_get_section_name(loadfile_bfd, s), -1);
2438 ob[1] = Tcl_NewLongObj ((long)size);
2439 res[i++] = Tcl_NewListObj (2, ob);
2440 }
2441 }
2442 }
2443
2444 Tcl_SetObjResult (interp, Tcl_NewListObj (i, res));
2445 do_cleanups (old_cleanups);
2446 return TCL_OK;
2447}
2448
2449
2450int
2451gdbtk_load_hash (section, num)
2452 char *section;
2453 unsigned long num;
2454{
018d76dd
KS		 2455 char buf[128];
2456 sprintf (buf, "download_hash %s %ld", section, num);
0776b0b0
MH		 2457 Tcl_Eval (interp, buf);
2458 return atoi (interp->result);
018d76dd
KS		 2459}
2460
2461/* gdb_get_vars_command -
2462 *
2463 * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
2464 * function sets the Tcl interpreter's result to a list of variable names
2465 * depending on clientData. If clientData is one, the result is a list of
2466 * arguments; zero returns a list of locals -- all relative to the block
2467 * specified as an argument to the command. Valid commands include
2468 * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
2469 * and "main").
2470 */
2471static int
2472gdb_get_vars_command (clientData, interp, objc, objv)
2473 ClientData clientData;
2474 Tcl_Interp *interp;
2475 int objc;
2476 Tcl_Obj *CONST objv[];
2477{
2478 Tcl_Obj *result;
2479 struct symtabs_and_lines sals;
2480 struct symbol *sym;
2481 struct block *block;
2482 char **canonical, *args;
2483 int i, nsyms, arguments;
2484
2485 if (objc != 2)
2486 {
2487 Tcl_AppendResult (interp,
2488 "wrong # of args: should be \"",
2489 Tcl_GetStringFromObj (objv[0], NULL),
2490 " function:line|function|line|*addr\"");
2491 return TCL_ERROR;
2492 }
2493
2494 arguments = (int) clientData;
2495 args = Tcl_GetStringFromObj (objv[1], NULL);
2496 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2497 if (sals.nelts == 0)
2498 {
2499 Tcl_AppendResult (interp,
2500 "error decoding line", NULL);
2501 return TCL_ERROR;
2502 }
2503
2504 /* Initialize a list that will hold the results */
2505 result = Tcl_NewListObj (0, NULL);
2506
2507 /* Resolve all line numbers to PC's */
2508 for (i = 0; i < sals.nelts; i++)
2509 resolve_sal_pc (&sals.sals[i]);
2510
2511 block = block_for_pc (sals.sals[0].pc);
2512 while (block != 0)
2513 {
2514 nsyms = BLOCK_NSYMS (block);
2515 for (i = 0; i < nsyms; i++)
2516 {
2517 sym = BLOCK_SYM (block, i);
2518 switch (SYMBOL_CLASS (sym)) {
2519 default:
2520 case LOC_UNDEF: /* catches errors */
2521 case LOC_CONST: /* constant */
2522 case LOC_STATIC: /* static */
2523 case LOC_REGISTER: /* register */
2524 case LOC_TYPEDEF: /* local typedef */
2525 case LOC_LABEL: /* local label */
2526 case LOC_BLOCK: /* local function */
2527 case LOC_CONST_BYTES: /* loc. byte seq. */
2528 case LOC_UNRESOLVED: /* unresolved static */
2529 case LOC_OPTIMIZED_OUT: /* optimized out */
2530 break;
2531 case LOC_ARG: /* argument */
2532 case LOC_REF_ARG: /* reference arg */
2533 case LOC_REGPARM: /* register arg */
2534 case LOC_REGPARM_ADDR: /* indirect register arg */
2535 case LOC_LOCAL_ARG: /* stack arg */
2536 case LOC_BASEREG_ARG: /* basereg arg */
2537 if (arguments)
2538 Tcl_ListObjAppendElement (interp, result,
2539 Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
2540 break;
2541 case LOC_LOCAL: /* stack local */
2542 case LOC_BASEREG: /* basereg local */
2543 if (!arguments)
2544 Tcl_ListObjAppendElement (interp, result,
2545 Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
2546 break;
2547 }
2548 }
2549 if (BLOCK_FUNCTION (block))
2550 break;
2551 else
2552 block = BLOCK_SUPERBLOCK (block);
2553 }
2554
2555 Tcl_SetObjResult (interp, result);
2556 return TCL_OK;
2557}
2558
2559static int
2560gdb_get_line_command (clientData, interp, objc, objv)
2561 ClientData clientData;
2562 Tcl_Interp *interp;
2563 int objc;
2564 Tcl_Obj *CONST objv[];
2565{
2566 Tcl_Obj *result;
2567 struct symtabs_and_lines sals;
2568 char *args, **canonical;
2569
2570 if (objc != 2)
2571 {
2572 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2573 Tcl_GetStringFromObj (objv[0], NULL),
2574 " linespec\"");
2575 return TCL_ERROR;
2576 }
2577
2578 args = Tcl_GetStringFromObj (objv[1], NULL);
2579 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2580 if (sals.nelts == 1)
2581 {
2582 Tcl_SetObjResult (interp, Tcl_NewIntObj (sals.sals[0].line));
2583 return TCL_OK;
2584 }
2585
2586 Tcl_SetResult (interp, "N/A", TCL_STATIC);
2587 return TCL_OK;
2588}
2589
2590static int
2591gdb_get_file_command (clientData, interp, objc, objv)
2592 ClientData clientData;
2593 Tcl_Interp *interp;
2594 int objc;
2595 Tcl_Obj *CONST objv[];
2596{
2597 Tcl_Obj *result;
2598 struct symtabs_and_lines sals;
2599 char *args, **canonical;
2600
2601 if (objc != 2)
2602 {
2603 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2604 Tcl_GetStringFromObj (objv[0], NULL),
2605 " linespec\"");
2606 return TCL_ERROR;
2607 }
2608
2609 args = Tcl_GetStringFromObj (objv[1], NULL);
2610 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2611 if (sals.nelts == 1)
2612 {
2613 Tcl_SetResult (interp, sals.sals[0].symtab->filename, TCL_VOLATILE);
2614 return TCL_OK;
2615 }
2616
2617 Tcl_SetResult (interp, "N/A", TCL_STATIC);
2618 return TCL_OK;
2619}
2620
2621static int
2622gdb_get_function_command (clientData, interp, objc, objv)
2623 ClientData clientData;
2624 Tcl_Interp *interp;
2625 int objc;
2626 Tcl_Obj *CONST objv[];
2627{
2628 Tcl_Obj *result;
2629 char *function;
2630 struct symtabs_and_lines sals;
2631 char *args, **canonical;
2632
2633 if (objc != 2)
2634 {
2635 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2636 Tcl_GetStringFromObj (objv[0], NULL),
2637 " linespec\"");
2638 return TCL_ERROR;
2639 }
2640
2641 args = Tcl_GetStringFromObj (objv[1], NULL);
2642 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2643 if (sals.nelts == 1)
2644 {
2645 resolve_sal_pc (&sals.sals[0]);
2646 find_pc_partial_function (sals.sals[0].pc, &function, NULL, NULL);
2647 if (function != NULL)
2648 {
2649 Tcl_SetResult (interp, function, TCL_VOLATILE);
2650 return TCL_OK;
2651 }
2652 }
2653
2654 Tcl_SetResult (interp, "N/A", TCL_STATIC);
2655 return TCL_OK;
2656}
2657
2658static int
2659gdb_get_tracepoint_info (clientData, interp, objc, objv)
2660 ClientData clientData;
2661 Tcl_Interp *interp;
2662 int objc;
2663 Tcl_Obj *CONST objv[];
2664{
2665 struct symtab_and_line sal;
018d76dd
KS		 2666 int tpnum;
2667 struct tracepoint *tp;
2668 struct action_line *al;
2669 Tcl_Obj *list, *action_list;
09e4fde2 2670 char *filename, *funcname;
018d76dd
KS		 2671 char tmp[19];
2672
2673 if (objc != 2)
2674 error ("wrong # args");
2675
2676 Tcl_GetIntFromObj (NULL, objv[1], &tpnum);
2677
2678 ALL_TRACEPOINTS (tp)
2679 if (tp->number == tpnum)
2680 break;
2681
2682 if (tp == NULL)
2683 error ("Tracepoint #%d does not exist", tpnum);
2684
2685 list = Tcl_NewListObj (0, NULL);
09e4fde2
KS		 2686 sal = find_pc_line (tp->address, 0);
2687 filename = symtab_to_filename (sal.symtab);
2688 if (filename == NULL)
2689 filename = "N/A";
2690 Tcl_ListObjAppendElement (interp, list,
2691 Tcl_NewStringObj (filename, -1));
09e4fde2
KS		 2692 find_pc_partial_function (tp->address, &funcname, NULL, NULL);
2693 Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (funcname, -1));
4f17e6eb 2694 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (sal.line));
018d76dd
KS		 2695 sprintf (tmp, "0x%08x", tp->address);
2696 Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tmp, -1));
2697 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->enabled));
2698 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->pass_count));
2699 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->step_count));
2700 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->thread));
2701 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->hit_count));
2702
2703 /* Append a list of actions */
2704 action_list = Tcl_NewListObj (0, NULL);
2705 for (al = tp->actions; al != NULL; al = al->next)
2706 {
2707 Tcl_ListObjAppendElement (interp, action_list,
2708 Tcl_NewStringObj (al->action, -1));
2709 }
2710 Tcl_ListObjAppendElement (interp, list, action_list);
2711
2712 Tcl_SetObjResult (interp, list);
2713 return TCL_OK;
2714}
2715
929db6e5
EZ		 2716
2717/* TclDebug (const char *fmt, ...) works just like printf() but */
2718/* sends the output to the GDB TK debug window. */
2719/* Not for normal use; just a convenient tool for debugging */
2720void
2721#ifdef ANSI_PROTOTYPES
2722TclDebug (const char *fmt, ...)
2723#else
2724TclDebug (va_alist)
2725 va_dcl
2726#endif
2727{
2728 va_list args;
2729 char buf[512], *v[2], *merge;
2730
2731#ifdef ANSI_PROTOTYPES
2732 va_start (args, fmt);
2733#else
2734 char *fmt;
2735 va_start (args);
2736 fmt = va_arg (args, char *);
2737#endif
2738
2739 v[0] = "debug";
2740 v[1] = buf;
2741
2742 vsprintf (buf, fmt, args);
2743 va_end (args);
2744
2745 merge = Tcl_Merge (2, v);
2746 Tcl_Eval (interp, merge);
2747 Tcl_Free (merge);
2748}
2749
2750
2751/* Find the full pathname to a file, searching the symbol tables */
2752
2753static int
2754gdb_find_file_command (clientData, interp, objc, objv)
2755 ClientData clientData;
2756 Tcl_Interp *interp;
2757 int objc;
2758 Tcl_Obj *CONST objv[];
2759{
2760 char *filename = NULL;
2761 struct symtab *st;
2762
2763 if (objc != 2)
2764 {
2765 Tcl_WrongNumArgs(interp, 1, objv, "filename");
2766 return TCL_ERROR;
2767 }
2768
2769 st = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
2770 if (st)
2771 filename = st->fullname;
2772
2773 if (filename == NULL)
2774 Tcl_SetObjResult (interp, Tcl_NewStringObj ("", 0));
2775 else
2776 Tcl_SetObjResult (interp, Tcl_NewStringObj (filename, -1));
2777
2778 return TCL_OK;
2779}
2780
018d76dd
KS		 2781static void
2782gdbtk_create_tracepoint (tp)
2783 struct tracepoint *tp;
2784{
2785 tracepoint_notify (tp, "create");
2786}
2787
2788static void
2789gdbtk_delete_tracepoint (tp)
2790 struct tracepoint *tp;
2791{
2792 tracepoint_notify (tp, "delete");
2793}
2794
a5f4fbff
KS		 2795static void
2796gdbtk_modify_tracepoint (tp)
2797 struct tracepoint *tp;
2798{
2799 tracepoint_notify (tp, "modify");
2800}
2801
018d76dd
KS		 2802static void
2803tracepoint_notify(tp, action)
2804 struct tracepoint *tp;
2805 const char *action;
2806{
2807 char buf[256];
018d76dd 2808 int v;
09e4fde2
KS		 2809 struct symtab_and_line sal;
2810 char *filename;
018d76dd
KS		 2811
2812 /* We ensure that ACTION contains no special Tcl characters, so we
2813 can do this. */
09e4fde2
KS		 2814 sal = find_pc_line (tp->address, 0);
2815
2816 filename = symtab_to_filename (sal.symtab);
2817 if (filename == NULL)
2818 filename = "N/A";
018d76dd 2819 sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action, tp->number,
41158958 2820 (long)tp->address, sal.line, filename, tp->pass_count);
018d76dd
KS		 2821
2822 v = Tcl_Eval (interp, buf);
2823
2824 if (v != TCL_OK)
2825 {
2826 gdbtk_fputs (interp->result, gdb_stdout);
2827 gdbtk_fputs ("\n", gdb_stdout);
2828 }
2829}
2830
2831/* returns -1 if not found, tracepoint # if found */
2832int
2833tracepoint_exists (char * args)
2834{
2835 struct tracepoint *tp;
2836 char **canonical;
2837 struct symtabs_and_lines sals;
2838 char *file = NULL;
2839 int result = -1;
2840
2841 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2842 if (sals.nelts == 1)
2843 {
2844 resolve_sal_pc (&sals.sals[0]);
2845 file = xmalloc (strlen (sals.sals[0].symtab->dirname)
2846 + strlen (sals.sals[0].symtab->filename) + 1);
2847 if (file != NULL)
2848 {
2849 strcpy (file, sals.sals[0].symtab->dirname);
2850 strcat (file, sals.sals[0].symtab->filename);
2851
2852 ALL_TRACEPOINTS (tp)
2853 {
2854 if (tp->address == sals.sals[0].pc)
2855 result = tp->number;
2856 else if (tp->source_file != NULL
2857 && strcmp (tp->source_file, file) == 0
2858 && sals.sals[0].line == tp->line_number)
2859
2860 result = tp->number;
2861 }
2862 }
2863 }
2864 if (file != NULL)
2865 free (file);
2866 return result;
2867}
2868
2869static int
2870gdb_actions_command (clientData, interp, objc, objv)
2871 ClientData clientData;
2872 Tcl_Interp *interp;
2873 int objc;
2874 Tcl_Obj *CONST objv[];
2875{
2876 struct tracepoint *tp;
2877 Tcl_Obj **actions;
2878 int nactions, i, len;
2879 char *number, *args, *action;
43b043cf 2880 long step_count;
018d76dd
KS		 2881 struct action_line *next = NULL, *temp;
2882
2883 if (objc != 3)
2884 {
2885 Tcl_AppendResult (interp, "wrong # args: should be: \"",
2886 Tcl_GetStringFromObj (objv[0], NULL),
2887 " number actions\"");
2888 return TCL_ERROR;
2889 }
2890
2891 args = number = Tcl_GetStringFromObj (objv[1], NULL);
2892 tp = get_tracepoint_by_number (&args);
2893 if (tp == NULL)
2894 {
2895 Tcl_AppendResult (interp, "Tracepoint \"", number, "\" does not exist");
2896 return TCL_ERROR;
2897 }
2898
2899 /* Free any existing actions */
a5f4fbff
KS		 2900 if (tp->actions != NULL)
2901 free_actions (tp);
2902
43b043cf 2903 step_count = 0;
018d76dd
KS		 2904
2905 Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
2906 for (i = 0; i < nactions; i++)
2907 {
2908 temp = xmalloc (sizeof (struct action_line));
2909 temp->next = NULL;
2910 action = Tcl_GetStringFromObj (actions[i], &len);
2911 temp->action = savestring (action, len);
43b043cf
MS		 2912 if (sscanf (temp->action, "while-stepping %d", &step_count) !=0)
2913 tp->step_count = step_count;
018d76dd
KS		 2914 if (next == NULL)
2915 {
2916 tp->actions = temp;
2917 next = temp;
2918 }
2919 else
2920 {
2921 next->next = temp;
2922 next = temp;
2923 }
2924 }
2925
2926 return TCL_OK;
2927}
2928
2929static int
2930gdb_tracepoint_exists_command (clientData, interp, objc, objv)
2931 ClientData clientData;
2932 Tcl_Interp *interp;
2933 int objc;
2934 Tcl_Obj *CONST objv[];
2935{
2936 char * args;
2937
2938 if (objc != 2)
2939 {
2940 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2941 Tcl_GetStringFromObj (objv[0], NULL),
2942 " function:line|function|line|*addr\"");
2943 return TCL_ERROR;
2944 }
2945
2946 args = Tcl_GetStringFromObj (objv[1], NULL);
2947
2948 Tcl_SetObjResult (interp, Tcl_NewIntObj (tracepoint_exists (args)));
2949 return TCL_OK;
2950}
2951
2952/* Return the prompt to the interpreter */
2953static int
2954gdb_prompt_command (clientData, interp, objc, objv)
2955 ClientData clientData;
2956 Tcl_Interp *interp;
2957 int objc;
2958 Tcl_Obj *CONST objv[];
2959{
2960 Tcl_SetResult (interp, get_prompt (), TCL_VOLATILE);
2961 return TCL_OK;
2962}
2963
4f17e6eb
KS		 2964/* return a list of all tracepoint numbers in interpreter */
2965static int
2966gdb_get_tracepoint_list (clientData, interp, objc, objv)
2967 ClientData clientData;
2968 Tcl_Interp *interp;
2969 int objc;
2970 Tcl_Obj *CONST objv[];
2971{
2972 Tcl_Obj *list;
2973 struct tracepoint *tp;
2974
2975 list = Tcl_NewListObj (0, NULL);
2976
2977 ALL_TRACEPOINTS (tp)
2978 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->number));
2979
2980 Tcl_SetObjResult (interp, list);
2981 return TCL_OK;
2982}
e0f7db02 2983
e0f7db02 2984
929db6e5
EZ		 2985/* This hook is called whenever we are ready to load a symbol file so that
2986 the UI can notify the user... */
2987void
2988gdbtk_pre_add_symbol (name)
2989 char *name;
2990{
e924e162 2991 char *merge, *v[2];
e0f7db02 2992
e924e162
EZ		 2993 v[0] = "gdbtk_tcl_pre_add_symbol";
2994 v[1] = name;
2995 merge = Tcl_Merge (2, v);
2996 Tcl_Eval (interp, merge);
2997 Tcl_Free (merge);
929db6e5 2998}
e0f7db02 2999
929db6e5
EZ		 3000/* This hook is called whenever we finish loading a symbol file. */
3001void
3002gdbtk_post_add_symbol ()
3003{
3004 Tcl_Eval (interp, "gdbtk_tcl_post_add_symbol");
3005}
e0f7db02 3006
e0f7db02 3007
e0f7db02 3008
929db6e5
EZ		 3009static void
3010gdbtk_print_frame_info (s, line, stopline, noerror)
3011 struct symtab *s;
3012 int line;
3013 int stopline;
3014 int noerror;
3015{
3016 current_source_symtab = s;
3017 current_source_line = line;
3018}
3019
3020
3021/* The lookup_symtab() in symtab.c doesn't work correctly */
3022/* It will not work will full pathnames and if multiple */
3023/* source files have the same basename, it will return */
3024/* the first one instead of the correct one. This version */
3025/* also always makes sure symtab->fullname is set. */
3026
3027static struct symtab *
3028full_lookup_symtab(file)
3029 char *file;
3030{
3031 struct symtab *st;
3032 struct objfile *objfile;
3033 char *bfile, *fullname;
3034 struct partial_symtab *pt;
3035
3036 if (!file)
3037 return NULL;
3038
3039 /* first try a direct lookup */
3040 st = lookup_symtab (file);
3041 if (st)
3042 {
3043 if (!st->fullname)
3044 symtab_to_filename(st);
3045 return st;
3046 }
3047
3048 /* if the direct approach failed, try */
3049 /* looking up the basename and checking */
3050 /* all matches with the fullname */
3051 bfile = basename (file);
3052 ALL_SYMTABS (objfile, st)
3053 {
3054 if (!strcmp (bfile, basename(st->filename)))
3055 {
3056 if (!st->fullname)
3057 fullname = symtab_to_filename (st);
3058 else
3059 fullname = st->fullname;
3060
3061 if (!strcmp (file, fullname))
3062 return st;
3063 }
3064 }
3065
3066 /* still no luck? look at psymtabs */
3067 ALL_PSYMTABS (objfile, pt)
3068 {
3069 if (!strcmp (bfile, basename(pt->filename)))
3070 {
3071 st = PSYMTAB_TO_SYMTAB (pt);
3072 if (st)
3073 {
3074 fullname = symtab_to_filename (st);
3075 if (!strcmp (file, fullname))
3076 return st;
3077 }
3078 }
3079 }
3080 return NULL;
3081}
3082
3083
3084/* gdb_loadfile loads a c source file into a text widget. */
3085
3086/* LTABLE_SIZE is the number of bytes to allocate for the */
3087/* line table. Its size limits the maximum number of lines */
3088/* in a file to 8 * LTABLE_SIZE. This memory is freed after */
3089/* the file is loaded, so it is OK to make this very large. */
3090/* Additional memory will be allocated if needed. */
3091#define LTABLE_SIZE 20000
e0f7db02 3092
e0f7db02 3093static int
929db6e5 3094gdb_loadfile (clientData, interp, objc, objv)
e0f7db02
KS		 3095 ClientData clientData;
3096 Tcl_Interp *interp;
3097 int objc;
3098 Tcl_Obj *CONST objv[];
3099{
929db6e5
EZ		 3100 char *file, *widget, *line, *buf, msg[128];
3101 int linenumbers, ln, anum, lnum, ltable_size;
3102 Tcl_Obj *a[2], *b[2], *cmd;
3103 FILE *fp;
3104 char *ltable;
3105 struct symtab *symtab;
3106 struct linetable_entry *le;
3107
3108 if (objc != 4)
3109 {
3110 Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
3111 return TCL_ERROR;
3112 }
e0f7db02 3113
929db6e5
EZ		 3114 widget = Tcl_GetStringFromObj (objv[1], NULL);
3115 file = Tcl_GetStringFromObj (objv[2], NULL);
3116 Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
3117
3118 if ((fp = fopen ( file, "r" )) == NULL)
3119 return TCL_ERROR;
3120
3121 symtab = full_lookup_symtab (file);
3122 if (!symtab)
e0f7db02 3123 {
ed5fa7c3
MH		 3124 sprintf(msg, "File not found");
3125 Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
929db6e5 3126 fclose (fp);
e0f7db02
KS		 3127 return TCL_ERROR;
3128 }
3129
929db6e5
EZ		 3130 /* Source linenumbers don't appear to be in order, and a sort is */
3131 /* too slow so the fastest solution is just to allocate a huge */
3132 /* array and set the array entry for each linenumber */
3133
3134 ltable_size = LTABLE_SIZE;
3135 ltable = (char *)malloc (LTABLE_SIZE);
3136 if (ltable == NULL)
3137 {
3138 sprintf(msg, "Out of memory.");
3139 Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
3140 fclose (fp);
3141 return TCL_ERROR;
3142 }
3143
3144 memset (ltable, 0, LTABLE_SIZE);
3145
3146 if (symtab->linetable && symtab->linetable->nitems)
3147 {
3148 le = symtab->linetable->item;
3149 for (ln = symtab->linetable->nitems ;ln > 0; ln--, le++)
3150 {
3151 lnum = le->line >> 3;
3152 if (lnum >= ltable_size)
3153 {
3154 char *new_ltable;
3155 new_ltable = (char *)realloc (ltable, ltable_size*2);
3156 memset (new_ltable + ltable_size, 0, ltable_size);
3157 ltable_size *= 2;
3158 if (new_ltable == NULL)
3159 {
3160 sprintf(msg, "Out of memory.");
3161 Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
3162 free (ltable);
3163 fclose (fp);
3164 return TCL_ERROR;
3165 }
3166 ltable = new_ltable;
3167 }
3168 ltable[lnum] |= 1 << (le->line % 8);
3169 }
3170 }
11f91b2b 3171
929db6e5
EZ		 3172 /* create an object with enough space, then grab its */
3173 /* buffer and sprintf directly into it. */
3174 a[0] = Tcl_NewStringObj (ltable, 1024);
3175 a[1] = Tcl_NewListObj(0,NULL);
3176 buf = a[0]->bytes;
3177 b[0] = Tcl_NewStringObj (ltable,1024);
3178 b[1] = Tcl_NewStringObj ("source_tag", -1);
3179 Tcl_IncrRefCount (b[0]);
3180 Tcl_IncrRefCount (b[1]);
3181 line = b[0]->bytes + 1;
3182 strcpy(b[0]->bytes,"\t");
3183
3184 ln = 1;
3185 while (fgets (line, 980, fp))
3186 {
3187 if (linenumbers)
3188 {
3189 if (ltable[ln >> 3] & (1 << (ln % 8)))
3190 a[0]->length = sprintf (buf,"%s insert end {-\t%d} break_tag", widget, ln);
3191 else
ed5fa7c3 3192 a[0]->length = sprintf (buf,"%s insert end { \t%d} \"\"", widget, ln);
929db6e5
EZ		 3193 }
3194 else
3195 {
3196 if (ltable[ln >> 3] & (1 << (ln % 8)))
3197 a[0]->length = sprintf (buf,"%s insert end {-\t} break_tag", widget);
3198 else
ed5fa7c3 3199 a[0]->length = sprintf (buf,"%s insert end { \t} \"\"", widget);
929db6e5
EZ		 3200 }
3201 b[0]->length = strlen(b[0]->bytes);
3202 Tcl_SetListObj(a[1],2,b);
3203 cmd = Tcl_ConcatObj(2,a);
3204 Tcl_EvalObj (interp, cmd);
3205 Tcl_DecrRefCount (cmd);
3206 ln++;
3207 }
3208 Tcl_DecrRefCount (b[0]);
3209 Tcl_DecrRefCount (b[0]);
3210 Tcl_DecrRefCount (b[1]);
3211 Tcl_DecrRefCount (b[1]);
3212 free (ltable);
3213 fclose (fp);
11f91b2b
KS		 3214 return TCL_OK;
3215}
3216
929db6e5
EZ		 3217/* at some point make these static in breakpoint.c and move GUI code there */
3218extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
3219extern void set_breakpoint_count (int);
3220extern int breakpoint_count;
3221
3222/* set a breakpoint by source file and line number */
3223/* flags are as follows: */
3224/* least significant 2 bits are disposition, rest is */
3225/* type (normally 0).
3226
3227enum bptype {
3228 bp_breakpoint, Normal breakpoint
3229 bp_hardware_breakpoint, Hardware assisted breakpoint
3230}
3231
3232Disposition of breakpoint. Ie: what to do after hitting it.
3233enum bpdisp {
3234 del, Delete it
3235 del_at_next_stop, Delete at next stop, whether hit or not
3236 disable, Disable it
3237 donttouch Leave it alone
3238 };
3239*/
3240
3241static int
3242gdb_set_bp (clientData, interp, objc, objv)
3243 ClientData clientData;
3244 Tcl_Interp *interp;
3245 int objc;
3246 Tcl_Obj *CONST objv[];
3247
11f91b2b 3248{
929db6e5
EZ		 3249 struct symtab_and_line sal;
3250 int line, flags, ret;
3251 struct breakpoint *b;
3252 char buf[64];
3253 Tcl_Obj *a[5], *cmd;
e0f7db02 3254
929db6e5 3255 if (objc != 4)
e0f7db02 3256 {
929db6e5
EZ		 3257 Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
3258 return TCL_ERROR;
e0f7db02 3259 }
11f91b2b 3260
929db6e5
EZ		 3261 sal.symtab = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL));
3262 if (sal.symtab == NULL)
3263 return TCL_ERROR;
3264
3265 if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR)
3266 return TCL_ERROR;
3267
3268 if (Tcl_GetIntFromObj( interp, objv[3], &flags) == TCL_ERROR)
3269 return TCL_ERROR;
3270
3271 sal.line = line;
3272 sal.pc = find_line_pc (sal.symtab, sal.line);
3273 if (sal.pc == 0)
3274 return TCL_ERROR;
3275
3276 sal.section = find_pc_overlay (sal.pc);
3277 b = set_raw_breakpoint (sal);
3278 set_breakpoint_count (breakpoint_count + 1);
3279 b->number = breakpoint_count;
3280 b->type = flags >> 2;
3281 b->disposition = flags & 3;
3282
3283 /* FIXME: this won't work for duplicate basenames! */
3284 sprintf (buf, "%s:%d", basename(Tcl_GetStringFromObj( objv[1], NULL)), line);
3285 b->addr_string = strsave (buf);
3286
3287 /* now send notification command back to GUI */
3288 sprintf (buf, "0x%x", sal.pc);
3289 a[0] = Tcl_NewStringObj ("gdbtk_tcl_breakpoint create", -1);
3290 a[1] = Tcl_NewIntObj (b->number);
3291 a[2] = Tcl_NewStringObj (buf, -1);
3292 a[3] = objv[2];
3293 a[4] = Tcl_NewListObj (1,&objv[1]);
3294 cmd = Tcl_ConcatObj(5,a);
3295 ret = Tcl_EvalObj (interp, cmd);
3296 Tcl_DecrRefCount (cmd);
3297 return ret;
11f91b2b 3298}
4f17e6eb 3299
929db6e5
EZ		 3300#ifdef __CYGWIN32__
3301/* The whole timer idea is an easy one, but POSIX does not appear to have
3302 some sort of interval timer requirement. Consequently, we cannot rely
3303 on cygwin32 to always deliver the timer's signal. This is especially
3304 painful given that all serial I/O will block the timer right now. */
3305static void
3306gdbtk_annotate_starting ()
11f91b2b 3307{
929db6e5
EZ		 3308 /* TclDebug ("### STARTING ###"); */
3309 gdbtk_start_timer ();
11f91b2b
KS		 3310}
3311
929db6e5
EZ		 3312static void
3313gdbtk_annotate_stopped ()
11f91b2b 3314{
929db6e5
EZ		 3315 /* TclDebug ("### STOPPED ###"); */
3316 gdbtk_stop_timer ();
e0f7db02
KS		 3317}
3318
929db6e5
EZ		 3319static void
3320gdbtk_annotate_exited ()
0776b0b0 3321{
929db6e5
EZ		 3322 /* TclDebug ("### EXITED ###"); */
3323 gdbtk_stop_timer ();
0776b0b0
MH		 3324}
3325
a5f4fbff 3326static void
929db6e5 3327gdbtk_annotate_signalled ()
a5f4fbff 3328{
929db6e5
EZ		 3329 /* TclDebug ("### SIGNALLED ###"); */
3330 gdbtk_stop_timer ();
a5f4fbff 3331}
929db6e5 3332#endif
0776b0b0 3333
3f37b696 3334/* Come here during initialize_all_files () */
754e5da2
SG		 3335
3336void
3337_initialize_gdbtk ()
3338{
c5197511
SG		 3339 if (use_windows)
3340 {
3341 /* Tell the rest of the world that Gdbtk is now set up. */
754e5da2 3342
c5197511
SG		 3343 init_ui_hook = gdbtk_init;
3344 }
754e5da2 3345}
GDB Binutils - Deliverables
This page took 0.308382 seconds and 4 git commands to generate.