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