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