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