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