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