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