projects / deliverable / binutils-gdb.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
tweak comment regarding state transitions
[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);
2476848a 2080 }
018d76dd 2081 /* end-sanitize-ide */
2476848a
MH		 2082#else
2083 Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
2084#endif /* IDE */
2085
9a2f9219
ILT		 2086 /* We don't want to open the X connection until we've done all the
2087 IDE initialization. Otherwise, goofy looking unfinished windows
2088 pop up when ILU drops into the TCL event loop. */
2089
2090 if (Tk_Init(interp) != TCL_OK)
2091 error ("Tk_Init failed: %s", interp->result);
2092
2093 if (Itcl_Init(interp) == TCL_ERROR)
2094 error ("Itcl_Init failed: %s", interp->result);
2095
2096 if (Tix_Init(interp) != TCL_OK)
2097 error ("Tix_Init failed: %s", interp->result);
2098
018d76dd 2099#ifdef __CYGWIN32__
929db6e5
EZ		 2100 if (ide_create_messagebox_command (interp) != TCL_OK)
2101 error ("messagebox command initialization failed");
018d76dd
KS		 2102 /* On Windows, create a sizebox widget command */
2103 if (ide_create_sizebox_command (interp) != TCL_OK)
2104 error ("sizebox creation failed");
2105 if (ide_create_winprint_command (interp) != TCL_OK)
2106 error ("windows print code initialization failed");
2107 /* start-sanitize-ide */
2108 /* An interface to ShellExecute. */
2109 if (ide_create_shell_execute_command (interp) != TCL_OK)
2110 error ("shell execute command initialization failed");
06434f5f 2111 /* end-sanitize-ide */
929db6e5
EZ		 2112 if (ide_create_win_grab_command (interp) != TCL_OK)
2113 error ("grab support command initialization failed");
2114 /* Path conversion functions. */
2115 if (ide_create_cygwin_path_command (interp) != TCL_OK)
2116 error ("cygwin path command initialization failed");
018d76dd
KS		 2117#endif
2118
86db943c 2119 Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
0422b59e
KS		 2120 Tcl_CreateCommand (interp, "gdb_immediate", call_wrapper,
2121 gdb_immediate_command, NULL);
86db943c 2122 Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
8a19b35a 2123 Tcl_CreateCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
0776b0b0 2124 Tcl_CreateObjCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
99c98415
MH		 2125 Tcl_CreateCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
2126 NULL);
018d76dd
KS		 2127 Tcl_CreateCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
2128 NULL);
86db943c
SG		 2129 Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
2130 Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
2131 Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
2132 gdb_fetch_registers, NULL);
2133 Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
2134 gdb_changed_register_list, NULL);
09722039
SG		 2135 Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
2136 gdb_disassemble, NULL);
2137 Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
6131622e
SG		 2138 Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
2139 gdb_get_breakpoint_list, NULL);
2140 Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
2141 gdb_get_breakpoint_info, NULL);
018d76dd
KS		 2142 Tcl_CreateCommand (interp, "gdb_clear_file", call_wrapper,
2143 gdb_clear_file, NULL);
2144 Tcl_CreateCommand (interp, "gdb_confirm_quit", call_wrapper,
2145 gdb_confirm_quit, NULL);
2146 Tcl_CreateCommand (interp, "gdb_force_quit", call_wrapper,
2147 gdb_force_quit, NULL);
2148 Tcl_CreateCommand (interp, "gdb_target_has_execution",
2149 gdb_target_has_execution_command,
2150 NULL, NULL);
41158958
EZ		 2151 Tcl_CreateCommand (interp, "gdb_is_tracing",
2152 gdb_trace_status,
2153 NULL, NULL);
018d76dd
KS		 2154 Tcl_CreateObjCommand (interp, "gdb_load_info", gdb_load_info, NULL, NULL);
2155 Tcl_CreateObjCommand (interp, "gdb_get_locals", gdb_get_vars_command,
2156 (ClientData) 0, NULL);
2157 Tcl_CreateObjCommand (interp, "gdb_get_args", gdb_get_vars_command,
2158 (ClientData) 1, NULL);
2159 Tcl_CreateObjCommand (interp, "gdb_get_function", gdb_get_function_command,
2160 NULL, NULL);
2161 Tcl_CreateObjCommand (interp, "gdb_get_line", gdb_get_line_command,
2162 NULL, NULL);
2163 Tcl_CreateObjCommand (interp, "gdb_get_file", gdb_get_file_command,
2164 NULL, NULL);
2165 Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
2166 gdb_tracepoint_exists_command, NULL, NULL);
2167 Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
2168 gdb_get_tracepoint_info, NULL, NULL);
2169 Tcl_CreateObjCommand (interp, "gdb_actions",
2170 gdb_actions_command, NULL, NULL);
2171 Tcl_CreateObjCommand (interp, "gdb_prompt",
2172 gdb_prompt_command, NULL, NULL);
e0f7db02
KS		 2173 Tcl_CreateObjCommand (interp, "gdb_find_file",
2174 gdb_find_file_command, NULL, NULL);
4f17e6eb 2175 Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
929db6e5
EZ		 2176 gdb_get_tracepoint_list, NULL, NULL);
2177 Tcl_CreateCommand (interp, "gdb_pc_reg", get_pc_register, NULL, NULL);
2178 Tcl_CreateObjCommand (interp, "gdb_loadfile", gdb_loadfile, NULL, NULL);
2179 Tcl_CreateObjCommand (interp, "gdb_set_bp", gdb_set_bp, NULL, NULL);
2180
5bac2b50 2181 command_loop_hook = tk_command_loop;
a5f4fbff 2182 print_frame_info_listing_hook = gdbtk_print_frame_info;
09722039
SG		 2183 query_hook = gdbtk_query;
2184 flush_hook = gdbtk_flush;
2185 create_breakpoint_hook = gdbtk_create_breakpoint;
2186 delete_breakpoint_hook = gdbtk_delete_breakpoint;
6131622e 2187 modify_breakpoint_hook = gdbtk_modify_breakpoint;
09722039
SG		 2188 interactive_hook = gdbtk_interactive;
2189 target_wait_hook = gdbtk_wait;
2190 call_command_hook = gdbtk_call_command;
41756e56
FF		 2191 readline_begin_hook = gdbtk_readline_begin;
2192 readline_hook = gdbtk_readline;
2193 readline_end_hook = gdbtk_readline_end;
018d76dd 2194 ui_load_progress_hook = gdbtk_load_hash;
11f91b2b
KS		 2195 pre_add_symbol_hook = gdbtk_pre_add_symbol;
2196 post_add_symbol_hook = gdbtk_post_add_symbol;
018d76dd
KS		 2197 create_tracepoint_hook = gdbtk_create_tracepoint;
2198 delete_tracepoint_hook = gdbtk_delete_tracepoint;
a5f4fbff 2199 modify_tracepoint_hook = gdbtk_modify_tracepoint;
929db6e5
EZ		 2200 pc_changed_hook = pc_changed;
2201#ifdef __CYGWIN32__
2202 annotate_starting_hook = gdbtk_annotate_starting;
2203 annotate_stopped_hook = gdbtk_annotate_stopped;
2204 annotate_signalled_hook = gdbtk_annotate_signalled;
2205 annotate_exited_hook = gdbtk_annotate_exited;
2206 ui_loop_hook = x_event;
2207#endif
018d76dd 2208#ifndef WINNT
cd2df226 2209 /* Get the file descriptor for the X server */
479f0f18 2210
047465fd 2211 x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
479f0f18
SG		 2212
2213 /* Setup for I/O interrupts */
2214
736a82e7
SG		 2215 action.sa_mask = nullsigmask;
2216 action.sa_flags = 0;
2217 action.sa_handler = SIG_IGN;
2218 sigaction(SIGIO, &action, NULL);
2219
2220#ifdef FIOASYNC
2221 i = 1;
2222 if (ioctl (x_fd, FIOASYNC, &i))
2223 perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
479f0f18 2224
77a89957 2225#ifdef SIOCSPGRP
736a82e7
SG		 2226 i = getpid();
2227 if (ioctl (x_fd, SIOCSPGRP, &i))
2228 perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
45f90c50
MM		 2229
2230#else
2231#ifdef F_SETOWN
2232 i = getpid();
2233 if (fcntl (x_fd, F_SETOWN, i))
2234 perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
2235#endif /* F_SETOWN */
2236#endif /* !SIOCSPGRP */
546b8ca7 2237#else
8a19b35a 2238#ifndef WINNT
546b8ca7 2239 if (ioctl (x_fd, I_SETSIG, S_INPUT|S_RDNORM) < 0)
736a82e7 2240 perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
8a19b35a
MH		 2241#endif
2242
736a82e7 2243#endif /* ifndef FIOASYNC */
018d76dd 2244#endif /* WINNT */
479f0f18 2245
754e5da2
SG		 2246 add_com ("tk", class_obscure, tk_command,
2247 "Send a command directly into tk.");
09722039 2248
09722039
SG		 2249 Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
2250 TCL_LINK_INT);
2251
8a19b35a 2252 /* find the gdb tcl library and source main.tcl */
09722039 2253
8a19b35a
MH		 2254 gdbtk_lib = getenv ("GDBTK_LIBRARY");
2255 if (!gdbtk_lib)
2256 if (access ("gdbtcl/main.tcl", R_OK) == 0)
2257 gdbtk_lib = "gdbtcl";
09722039 2258 else
8a19b35a
MH		 2259 gdbtk_lib = GDBTK_LIBRARY;
2260
74089546
ILT		 2261 gdbtk_lib_tmp = xstrdup (gdbtk_lib);
2262
8a19b35a
MH		 2263 found_main = 0;
2264 /* see if GDBTK_LIBRARY is a path list */
2265 lib = strtok (gdbtk_lib_tmp, GDBTK_PATH_SEP);
2266 do
2267 {
2268 if (Tcl_VarEval (interp, "lappend auto_path ", lib, NULL) != TCL_OK)
2269 {
2270 fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
2271 error ("");
2272 }
2273 if (!found_main)
2274 {
74089546 2275 gdbtk_file = concat (lib, "/main.tcl", (char *) NULL);
8a19b35a
MH		 2276 if (access (gdbtk_file, R_OK) == 0)
2277 {
2278 found_main++;
2279 Tcl_SetVar (interp, "GDBTK_LIBRARY", lib, 0);
2280 }
2281 }
2282 }
56e327b3 2283 while ((lib = strtok (NULL, ":")) != NULL);
74089546
ILT		 2284
2285 free (gdbtk_lib_tmp);
2286
74089546
ILT		 2287 if (!found_main)
2288 {
2289 /* Try finding it with the auto path. */
2290
2291 static const char script[] ="\
2292proc gdbtk_find_main {} {\n\
2293 global auto_path GDBTK_LIBRARY\n\
2294 foreach dir $auto_path {\n\
2295 set f [file join $dir main.tcl]\n\
2296 if {[file exists $f]} then {\n\
2297 set GDBTK_LIBRARY $dir\n\
2298 return $f\n\
2299 }\n\
2300 }\n\
2301 return ""\n\
2302}\n\
2303gdbtk_find_main";
2304
2305 if (Tcl_GlobalEval (interp, (char *) script) != TCL_OK)
2306 {
2307 fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
2308 error ("");
2309 }
2310
2311 if (interp->result[0] != '\0')
2312 {
2313 gdbtk_file = xstrdup (interp->result);
2314 found_main++;
2315 }
2316 }
74089546 2317
8a19b35a
MH		 2318 if (!found_main)
2319 {
2320 fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
2321 if (getenv("GDBTK_LIBRARY"))
2322 {
2323 fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
2324 fprintf_unfiltered (stderr,
2325 "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
2326 }
2327 else
2328 {
2329 fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY);
2330 fprintf_unfiltered (stderr, "You might want to set GDBTK_LIBRARY\n");
2331 }
2332 error("");
2333 }
09722039 2334
724498fd
SG		 2335/* Defer setup of fputs_unfiltered_hook to near the end so that error messages
2336 prior to this point go to stdout/stderr. */
2337
2338 fputs_unfiltered_hook = gdbtk_fputs;
2339
8a19b35a 2340 if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK)
724498fd 2341 {
018d76dd
KS		 2342 char *msg;
2343
2344 /* Force errorInfo to be set up propertly. */
2345 Tcl_AddErrorInfo (interp, "");
2346
2347 msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
2348
724498fd
SG		 2349 fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
2350
018d76dd
KS		 2351#ifdef _WIN32
2352 MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
2353#else
2354 fputs_unfiltered (msg, gdb_stderr);
2355#endif
b66051ec 2356
b66051ec 2357 error ("");
724498fd 2358 }
09722039 2359
018d76dd
KS		 2360#ifdef IDE
2361 /* start-sanitize-ide */
2362 /* Don't do this until we have initialized. Otherwise, we may get a
2363 run command before we are ready for one. */
2364 if (ide_run_server_init (interp, h) != TCL_OK)
2365 error ("ide_run_server_init failed: %s", interp->result);
2366 /* end-sanitize-ide */
2367#endif
2368
74089546
ILT		 2369 free (gdbtk_file);
2370
09722039 2371 discard_cleanups (old_chain);
754e5da2
SG		 2372}
2373
018d76dd
KS		 2374static int
2375gdb_target_has_execution_command (clientData, interp, argc, argv)
2376 ClientData clientData;
2377 Tcl_Interp *interp;
2378 int argc;
2379 char *argv[];
2380{
2381 int result = 0;
2382
2383 if (target_has_execution && inferior_pid != 0)
2384 result = 1;
2385
2386 Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
2387 return TCL_OK;
2388}
2389
41158958
EZ		 2390static int
2391gdb_trace_status (clientData, interp, argc, argv)
2392 ClientData clientData;
2393 Tcl_Interp *interp;
2394 int argc;
2395 char *argv[];
2396{
2397 int result = 0;
2398
2399 if (trace_running_p)
2400 result = 1;
2401
2402 Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
2403 return TCL_OK;
2404}
2405
018d76dd
KS		 2406/* gdb_load_info - returns information about the file about to be downloaded */
2407
2408static int
2409gdb_load_info (clientData, interp, objc, objv)
2410 ClientData clientData;
2411 Tcl_Interp *interp;
2412 int objc;
2413 Tcl_Obj *CONST objv[];
2414{
2415 bfd *loadfile_bfd;
2416 struct cleanup *old_cleanups;
2417 asection *s;
2418 Tcl_Obj *ob[2];
2419 Tcl_Obj *res[16];
2420 int i = 0;
2421
2422 char *filename = Tcl_GetStringFromObj (objv[1], NULL);
2423
2424 loadfile_bfd = bfd_openr (filename, gnutarget);
2425 if (loadfile_bfd == NULL)
2426 {
2427 Tcl_SetObjResult (interp, Tcl_NewStringObj ("Open failed", -1));
2428 return TCL_ERROR;
2429 }
2430 old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
2431
2432 if (!bfd_check_format (loadfile_bfd, bfd_object))
2433 {
2434 Tcl_SetObjResult (interp, Tcl_NewStringObj ("Bad Object File", -1));
2435 return TCL_ERROR;
2436 }
2437
2438 for (s = loadfile_bfd->sections; s; s = s->next)
2439 {
2440 if (s->flags & SEC_LOAD)
2441 {
2442 bfd_size_type size = bfd_get_section_size_before_reloc (s);
2443 if (size > 0)
2444 {
2445 ob[0] = Tcl_NewStringObj((char *)bfd_get_section_name(loadfile_bfd, s), -1);
2446 ob[1] = Tcl_NewLongObj ((long)size);
2447 res[i++] = Tcl_NewListObj (2, ob);
2448 }
2449 }
2450 }
2451
2452 Tcl_SetObjResult (interp, Tcl_NewListObj (i, res));
2453 do_cleanups (old_cleanups);
2454 return TCL_OK;
2455}
2456
2457
2458int
2459gdbtk_load_hash (section, num)
2460 char *section;
2461 unsigned long num;
2462{
018d76dd
KS		 2463 char buf[128];
2464 sprintf (buf, "download_hash %s %ld", section, num);
0776b0b0
MH		 2465 Tcl_Eval (interp, buf);
2466 return atoi (interp->result);
018d76dd
KS		 2467}
2468
2469/* gdb_get_vars_command -
2470 *
2471 * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
2472 * function sets the Tcl interpreter's result to a list of variable names
2473 * depending on clientData. If clientData is one, the result is a list of
2474 * arguments; zero returns a list of locals -- all relative to the block
2475 * specified as an argument to the command. Valid commands include
2476 * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
2477 * and "main").
2478 */
2479static int
2480gdb_get_vars_command (clientData, interp, objc, objv)
2481 ClientData clientData;
2482 Tcl_Interp *interp;
2483 int objc;
2484 Tcl_Obj *CONST objv[];
2485{
2486 Tcl_Obj *result;
2487 struct symtabs_and_lines sals;
2488 struct symbol *sym;
2489 struct block *block;
2490 char **canonical, *args;
2491 int i, nsyms, arguments;
2492
2493 if (objc != 2)
2494 {
2495 Tcl_AppendResult (interp,
2496 "wrong # of args: should be \"",
2497 Tcl_GetStringFromObj (objv[0], NULL),
2498 " function:line|function|line|*addr\"");
2499 return TCL_ERROR;
2500 }
2501
2502 arguments = (int) clientData;
2503 args = Tcl_GetStringFromObj (objv[1], NULL);
2504 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2505 if (sals.nelts == 0)
2506 {
2507 Tcl_AppendResult (interp,
2508 "error decoding line", NULL);
2509 return TCL_ERROR;
2510 }
2511
2512 /* Initialize a list that will hold the results */
2513 result = Tcl_NewListObj (0, NULL);
2514
2515 /* Resolve all line numbers to PC's */
2516 for (i = 0; i < sals.nelts; i++)
2517 resolve_sal_pc (&sals.sals[i]);
2518
2519 block = block_for_pc (sals.sals[0].pc);
2520 while (block != 0)
2521 {
2522 nsyms = BLOCK_NSYMS (block);
2523 for (i = 0; i < nsyms; i++)
2524 {
2525 sym = BLOCK_SYM (block, i);
2526 switch (SYMBOL_CLASS (sym)) {
2527 default:
2528 case LOC_UNDEF: /* catches errors */
2529 case LOC_CONST: /* constant */
2530 case LOC_STATIC: /* static */
2531 case LOC_REGISTER: /* register */
2532 case LOC_TYPEDEF: /* local typedef */
2533 case LOC_LABEL: /* local label */
2534 case LOC_BLOCK: /* local function */
2535 case LOC_CONST_BYTES: /* loc. byte seq. */
2536 case LOC_UNRESOLVED: /* unresolved static */
2537 case LOC_OPTIMIZED_OUT: /* optimized out */
2538 break;
2539 case LOC_ARG: /* argument */
2540 case LOC_REF_ARG: /* reference arg */
2541 case LOC_REGPARM: /* register arg */
2542 case LOC_REGPARM_ADDR: /* indirect register arg */
2543 case LOC_LOCAL_ARG: /* stack arg */
2544 case LOC_BASEREG_ARG: /* basereg arg */
2545 if (arguments)
2546 Tcl_ListObjAppendElement (interp, result,
2547 Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
2548 break;
2549 case LOC_LOCAL: /* stack local */
2550 case LOC_BASEREG: /* basereg local */
2551 if (!arguments)
2552 Tcl_ListObjAppendElement (interp, result,
2553 Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
2554 break;
2555 }
2556 }
2557 if (BLOCK_FUNCTION (block))
2558 break;
2559 else
2560 block = BLOCK_SUPERBLOCK (block);
2561 }
2562
2563 Tcl_SetObjResult (interp, result);
2564 return TCL_OK;
2565}
2566
2567static int
2568gdb_get_line_command (clientData, interp, objc, objv)
2569 ClientData clientData;
2570 Tcl_Interp *interp;
2571 int objc;
2572 Tcl_Obj *CONST objv[];
2573{
2574 Tcl_Obj *result;
2575 struct symtabs_and_lines sals;
2576 char *args, **canonical;
2577
2578 if (objc != 2)
2579 {
2580 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2581 Tcl_GetStringFromObj (objv[0], NULL),
2582 " linespec\"");
2583 return TCL_ERROR;
2584 }
2585
2586 args = Tcl_GetStringFromObj (objv[1], NULL);
2587 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2588 if (sals.nelts == 1)
2589 {
2590 Tcl_SetObjResult (interp, Tcl_NewIntObj (sals.sals[0].line));
2591 return TCL_OK;
2592 }
2593
2594 Tcl_SetResult (interp, "N/A", TCL_STATIC);
2595 return TCL_OK;
2596}
2597
2598static int
2599gdb_get_file_command (clientData, interp, objc, objv)
2600 ClientData clientData;
2601 Tcl_Interp *interp;
2602 int objc;
2603 Tcl_Obj *CONST objv[];
2604{
2605 Tcl_Obj *result;
2606 struct symtabs_and_lines sals;
2607 char *args, **canonical;
2608
2609 if (objc != 2)
2610 {
2611 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2612 Tcl_GetStringFromObj (objv[0], NULL),
2613 " linespec\"");
2614 return TCL_ERROR;
2615 }
2616
2617 args = Tcl_GetStringFromObj (objv[1], NULL);
2618 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2619 if (sals.nelts == 1)
2620 {
2621 Tcl_SetResult (interp, sals.sals[0].symtab->filename, TCL_VOLATILE);
2622 return TCL_OK;
2623 }
2624
2625 Tcl_SetResult (interp, "N/A", TCL_STATIC);
2626 return TCL_OK;
2627}
2628
2629static int
2630gdb_get_function_command (clientData, interp, objc, objv)
2631 ClientData clientData;
2632 Tcl_Interp *interp;
2633 int objc;
2634 Tcl_Obj *CONST objv[];
2635{
2636 Tcl_Obj *result;
2637 char *function;
2638 struct symtabs_and_lines sals;
2639 char *args, **canonical;
2640
2641 if (objc != 2)
2642 {
2643 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2644 Tcl_GetStringFromObj (objv[0], NULL),
2645 " linespec\"");
2646 return TCL_ERROR;
2647 }
2648
2649 args = Tcl_GetStringFromObj (objv[1], NULL);
2650 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2651 if (sals.nelts == 1)
2652 {
2653 resolve_sal_pc (&sals.sals[0]);
2654 find_pc_partial_function (sals.sals[0].pc, &function, NULL, NULL);
2655 if (function != NULL)
2656 {
2657 Tcl_SetResult (interp, function, TCL_VOLATILE);
2658 return TCL_OK;
2659 }
2660 }
2661
2662 Tcl_SetResult (interp, "N/A", TCL_STATIC);
2663 return TCL_OK;
2664}
2665
2666static int
2667gdb_get_tracepoint_info (clientData, interp, objc, objv)
2668 ClientData clientData;
2669 Tcl_Interp *interp;
2670 int objc;
2671 Tcl_Obj *CONST objv[];
2672{
2673 struct symtab_and_line sal;
018d76dd
KS		 2674 int tpnum;
2675 struct tracepoint *tp;
2676 struct action_line *al;
2677 Tcl_Obj *list, *action_list;
09e4fde2 2678 char *filename, *funcname;
018d76dd
KS		 2679 char tmp[19];
2680
2681 if (objc != 2)
2682 error ("wrong # args");
2683
2684 Tcl_GetIntFromObj (NULL, objv[1], &tpnum);
2685
2686 ALL_TRACEPOINTS (tp)
2687 if (tp->number == tpnum)
2688 break;
2689
2690 if (tp == NULL)
2691 error ("Tracepoint #%d does not exist", tpnum);
2692
2693 list = Tcl_NewListObj (0, NULL);
09e4fde2
KS		 2694 sal = find_pc_line (tp->address, 0);
2695 filename = symtab_to_filename (sal.symtab);
2696 if (filename == NULL)
2697 filename = "N/A";
2698 Tcl_ListObjAppendElement (interp, list,
2699 Tcl_NewStringObj (filename, -1));
09e4fde2
KS		 2700 find_pc_partial_function (tp->address, &funcname, NULL, NULL);
2701 Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (funcname, -1));
4f17e6eb 2702 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (sal.line));
c62a71b6 2703 sprintf (tmp, "0x%lx", tp->address);
018d76dd
KS		 2704 Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tmp, -1));
2705 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->enabled));
2706 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->pass_count));
2707 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->step_count));
2708 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->thread));
2709 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->hit_count));
2710
2711 /* Append a list of actions */
2712 action_list = Tcl_NewListObj (0, NULL);
2713 for (al = tp->actions; al != NULL; al = al->next)
2714 {
2715 Tcl_ListObjAppendElement (interp, action_list,
2716 Tcl_NewStringObj (al->action, -1));
2717 }
2718 Tcl_ListObjAppendElement (interp, list, action_list);
2719
2720 Tcl_SetObjResult (interp, list);
2721 return TCL_OK;
2722}
2723
929db6e5
EZ		 2724
2725/* TclDebug (const char *fmt, ...) works just like printf() but */
2726/* sends the output to the GDB TK debug window. */
2727/* Not for normal use; just a convenient tool for debugging */
2728void
2729#ifdef ANSI_PROTOTYPES
2730TclDebug (const char *fmt, ...)
2731#else
2732TclDebug (va_alist)
2733 va_dcl
2734#endif
2735{
2736 va_list args;
2737 char buf[512], *v[2], *merge;
2738
2739#ifdef ANSI_PROTOTYPES
2740 va_start (args, fmt);
2741#else
2742 char *fmt;
2743 va_start (args);
2744 fmt = va_arg (args, char *);
2745#endif
2746
2747 v[0] = "debug";
2748 v[1] = buf;
2749
2750 vsprintf (buf, fmt, args);
2751 va_end (args);
2752
2753 merge = Tcl_Merge (2, v);
2754 Tcl_Eval (interp, merge);
2755 Tcl_Free (merge);
2756}
2757
2758
2759/* Find the full pathname to a file, searching the symbol tables */
2760
2761static int
2762gdb_find_file_command (clientData, interp, objc, objv)
2763 ClientData clientData;
2764 Tcl_Interp *interp;
2765 int objc;
2766 Tcl_Obj *CONST objv[];
2767{
2768 char *filename = NULL;
2769 struct symtab *st;
2770
2771 if (objc != 2)
2772 {
2773 Tcl_WrongNumArgs(interp, 1, objv, "filename");
2774 return TCL_ERROR;
2775 }
2776
2777 st = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
2778 if (st)
2779 filename = st->fullname;
2780
2781 if (filename == NULL)
2782 Tcl_SetObjResult (interp, Tcl_NewStringObj ("", 0));
2783 else
2784 Tcl_SetObjResult (interp, Tcl_NewStringObj (filename, -1));
2785
2786 return TCL_OK;
2787}
2788
018d76dd
KS		 2789static void
2790gdbtk_create_tracepoint (tp)
2791 struct tracepoint *tp;
2792{
2793 tracepoint_notify (tp, "create");
2794}
2795
2796static void
2797gdbtk_delete_tracepoint (tp)
2798 struct tracepoint *tp;
2799{
2800 tracepoint_notify (tp, "delete");
2801}
2802
a5f4fbff
KS		 2803static void
2804gdbtk_modify_tracepoint (tp)
2805 struct tracepoint *tp;
2806{
2807 tracepoint_notify (tp, "modify");
2808}
2809
018d76dd
KS		 2810static void
2811tracepoint_notify(tp, action)
2812 struct tracepoint *tp;
2813 const char *action;
2814{
2815 char buf[256];
018d76dd 2816 int v;
09e4fde2
KS		 2817 struct symtab_and_line sal;
2818 char *filename;
018d76dd
KS		 2819
2820 /* We ensure that ACTION contains no special Tcl characters, so we
2821 can do this. */
09e4fde2
KS		 2822 sal = find_pc_line (tp->address, 0);
2823
2824 filename = symtab_to_filename (sal.symtab);
2825 if (filename == NULL)
2826 filename = "N/A";
018d76dd 2827 sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action, tp->number,
41158958 2828 (long)tp->address, sal.line, filename, tp->pass_count);
018d76dd
KS		 2829
2830 v = Tcl_Eval (interp, buf);
2831
2832 if (v != TCL_OK)
2833 {
2834 gdbtk_fputs (interp->result, gdb_stdout);
2835 gdbtk_fputs ("\n", gdb_stdout);
2836 }
2837}
2838
2839/* returns -1 if not found, tracepoint # if found */
2840int
2841tracepoint_exists (char * args)
2842{
2843 struct tracepoint *tp;
2844 char **canonical;
2845 struct symtabs_and_lines sals;
2846 char *file = NULL;
2847 int result = -1;
2848
2849 sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2850 if (sals.nelts == 1)
2851 {
2852 resolve_sal_pc (&sals.sals[0]);
2853 file = xmalloc (strlen (sals.sals[0].symtab->dirname)
2854 + strlen (sals.sals[0].symtab->filename) + 1);
2855 if (file != NULL)
2856 {
2857 strcpy (file, sals.sals[0].symtab->dirname);
2858 strcat (file, sals.sals[0].symtab->filename);
2859
2860 ALL_TRACEPOINTS (tp)
2861 {
2862 if (tp->address == sals.sals[0].pc)
2863 result = tp->number;
c62a71b6
KS		 2864#if 0
2865 /* Why is this here? This messes up assembly traces */
018d76dd
KS		 2866 else if (tp->source_file != NULL
2867 && strcmp (tp->source_file, file) == 0
2868 && sals.sals[0].line == tp->line_number)
018d76dd 2869 result = tp->number;
c62a71b6 2870#endif
018d76dd
KS		 2871 }
2872 }
2873 }
2874 if (file != NULL)
2875 free (file);
2876 return result;
2877}
2878
2879static int
2880gdb_actions_command (clientData, interp, objc, objv)
2881 ClientData clientData;
2882 Tcl_Interp *interp;
2883 int objc;
2884 Tcl_Obj *CONST objv[];
2885{
2886 struct tracepoint *tp;
2887 Tcl_Obj **actions;
2888 int nactions, i, len;
2889 char *number, *args, *action;
43b043cf 2890 long step_count;
018d76dd
KS		 2891 struct action_line *next = NULL, *temp;
2892
2893 if (objc != 3)
2894 {
2895 Tcl_AppendResult (interp, "wrong # args: should be: \"",
2896 Tcl_GetStringFromObj (objv[0], NULL),
2897 " number actions\"");
2898 return TCL_ERROR;
2899 }
2900
2901 args = number = Tcl_GetStringFromObj (objv[1], NULL);
2902 tp = get_tracepoint_by_number (&args);
2903 if (tp == NULL)
2904 {
2905 Tcl_AppendResult (interp, "Tracepoint \"", number, "\" does not exist");
2906 return TCL_ERROR;
2907 }
2908
2909 /* Free any existing actions */
a5f4fbff
KS		 2910 if (tp->actions != NULL)
2911 free_actions (tp);
2912
43b043cf 2913 step_count = 0;
018d76dd
KS		 2914
2915 Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
2916 for (i = 0; i < nactions; i++)
2917 {
2918 temp = xmalloc (sizeof (struct action_line));
2919 temp->next = NULL;
2920 action = Tcl_GetStringFromObj (actions[i], &len);
2921 temp->action = savestring (action, len);
43b043cf
MS		 2922 if (sscanf (temp->action, "while-stepping %d", &step_count) !=0)
2923 tp->step_count = step_count;
018d76dd
KS		 2924 if (next == NULL)
2925 {
2926 tp->actions = temp;
2927 next = temp;
2928 }
2929 else
2930 {
2931 next->next = temp;
2932 next = temp;
2933 }
2934 }
2935
2936 return TCL_OK;
2937}
2938
2939static int
2940gdb_tracepoint_exists_command (clientData, interp, objc, objv)
2941 ClientData clientData;
2942 Tcl_Interp *interp;
2943 int objc;
2944 Tcl_Obj *CONST objv[];
2945{
2946 char * args;
2947
2948 if (objc != 2)
2949 {
2950 Tcl_AppendResult (interp, "wrong # of args: should be \"",
2951 Tcl_GetStringFromObj (objv[0], NULL),
2952 " function:line|function|line|*addr\"");
2953 return TCL_ERROR;
2954 }
2955
2956 args = Tcl_GetStringFromObj (objv[1], NULL);
2957
2958 Tcl_SetObjResult (interp, Tcl_NewIntObj (tracepoint_exists (args)));
2959 return TCL_OK;
2960}
2961
2962/* Return the prompt to the interpreter */
2963static int
2964gdb_prompt_command (clientData, interp, objc, objv)
2965 ClientData clientData;
2966 Tcl_Interp *interp;
2967 int objc;
2968 Tcl_Obj *CONST objv[];
2969{
2970 Tcl_SetResult (interp, get_prompt (), TCL_VOLATILE);
2971 return TCL_OK;
2972}
2973
4f17e6eb
KS		 2974/* return a list of all tracepoint numbers in interpreter */
2975static int
2976gdb_get_tracepoint_list (clientData, interp, objc, objv)
2977 ClientData clientData;
2978 Tcl_Interp *interp;
2979 int objc;
2980 Tcl_Obj *CONST objv[];
2981{
2982 Tcl_Obj *list;
2983 struct tracepoint *tp;
2984
2985 list = Tcl_NewListObj (0, NULL);
2986
2987 ALL_TRACEPOINTS (tp)
2988 Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->number));
2989
2990 Tcl_SetObjResult (interp, list);
2991 return TCL_OK;
2992}
e0f7db02 2993
e0f7db02 2994
929db6e5
EZ		 2995/* This hook is called whenever we are ready to load a symbol file so that
2996 the UI can notify the user... */
2997void
2998gdbtk_pre_add_symbol (name)
2999 char *name;
3000{
e924e162 3001 char *merge, *v[2];
e0f7db02 3002
e924e162
EZ		 3003 v[0] = "gdbtk_tcl_pre_add_symbol";
3004 v[1] = name;
3005 merge = Tcl_Merge (2, v);
3006 Tcl_Eval (interp, merge);
3007 Tcl_Free (merge);
929db6e5 3008}
e0f7db02 3009
929db6e5
EZ		 3010/* This hook is called whenever we finish loading a symbol file. */
3011void
3012gdbtk_post_add_symbol ()
3013{
3014 Tcl_Eval (interp, "gdbtk_tcl_post_add_symbol");
3015}
e0f7db02 3016
e0f7db02 3017
e0f7db02 3018
929db6e5
EZ		 3019static void
3020gdbtk_print_frame_info (s, line, stopline, noerror)
3021 struct symtab *s;
3022 int line;
3023 int stopline;
3024 int noerror;
3025{
3026 current_source_symtab = s;
3027 current_source_line = line;
3028}
3029
3030
3031/* The lookup_symtab() in symtab.c doesn't work correctly */
3032/* It will not work will full pathnames and if multiple */
3033/* source files have the same basename, it will return */
3034/* the first one instead of the correct one. This version */
3035/* also always makes sure symtab->fullname is set. */
3036
3037static struct symtab *
3038full_lookup_symtab(file)
3039 char *file;
3040{
3041 struct symtab *st;
3042 struct objfile *objfile;
3043 char *bfile, *fullname;
3044 struct partial_symtab *pt;
3045
3046 if (!file)
3047 return NULL;
3048
3049 /* first try a direct lookup */
3050 st = lookup_symtab (file);
3051 if (st)
3052 {
3053 if (!st->fullname)
3054 symtab_to_filename(st);
3055 return st;
3056 }
3057
3058 /* if the direct approach failed, try */
3059 /* looking up the basename and checking */
3060 /* all matches with the fullname */
3061 bfile = basename (file);
3062 ALL_SYMTABS (objfile, st)
3063 {
3064 if (!strcmp (bfile, basename(st->filename)))
3065 {
3066 if (!st->fullname)
3067 fullname = symtab_to_filename (st);
3068 else
3069 fullname = st->fullname;
3070
3071 if (!strcmp (file, fullname))
3072 return st;
3073 }
3074 }
3075
3076 /* still no luck? look at psymtabs */
3077 ALL_PSYMTABS (objfile, pt)
3078 {
3079 if (!strcmp (bfile, basename(pt->filename)))
3080 {
3081 st = PSYMTAB_TO_SYMTAB (pt);
3082 if (st)
3083 {
3084 fullname = symtab_to_filename (st);
3085 if (!strcmp (file, fullname))
3086 return st;
3087 }
3088 }
3089 }
3090 return NULL;
3091}
3092
3093
3094/* gdb_loadfile loads a c source file into a text widget. */
3095
3096/* LTABLE_SIZE is the number of bytes to allocate for the */
3097/* line table. Its size limits the maximum number of lines */
3098/* in a file to 8 * LTABLE_SIZE. This memory is freed after */
3099/* the file is loaded, so it is OK to make this very large. */
3100/* Additional memory will be allocated if needed. */
3101#define LTABLE_SIZE 20000
e0f7db02 3102
e0f7db02 3103static int
929db6e5 3104gdb_loadfile (clientData, interp, objc, objv)
e0f7db02
KS		 3105 ClientData clientData;
3106 Tcl_Interp *interp;
3107 int objc;
3108 Tcl_Obj *CONST objv[];
3109{
929db6e5
EZ		 3110 char *file, *widget, *line, *buf, msg[128];
3111 int linenumbers, ln, anum, lnum, ltable_size;
3112 Tcl_Obj *a[2], *b[2], *cmd;
3113 FILE *fp;
3114 char *ltable;
3115 struct symtab *symtab;
3116 struct linetable_entry *le;
3117
3118 if (objc != 4)
3119 {
3120 Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
3121 return TCL_ERROR;
3122 }
e0f7db02 3123
929db6e5
EZ		 3124 widget = Tcl_GetStringFromObj (objv[1], NULL);
3125 file = Tcl_GetStringFromObj (objv[2], NULL);
3126 Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
3127
3128 if ((fp = fopen ( file, "r" )) == NULL)
3129 return TCL_ERROR;
3130
3131 symtab = full_lookup_symtab (file);
3132 if (!symtab)
e0f7db02 3133 {
ed5fa7c3
MH		 3134 sprintf(msg, "File not found");
3135 Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
929db6e5 3136 fclose (fp);
e0f7db02
KS		 3137 return TCL_ERROR;
3138 }
3139
929db6e5
EZ		 3140 /* Source linenumbers don't appear to be in order, and a sort is */
3141 /* too slow so the fastest solution is just to allocate a huge */
3142 /* array and set the array entry for each linenumber */
3143
3144 ltable_size = LTABLE_SIZE;
3145 ltable = (char *)malloc (LTABLE_SIZE);
3146 if (ltable == NULL)
3147 {
3148 sprintf(msg, "Out of memory.");
3149 Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
3150 fclose (fp);
3151 return TCL_ERROR;
3152 }
3153
3154 memset (ltable, 0, LTABLE_SIZE);
3155
3156 if (symtab->linetable && symtab->linetable->nitems)
3157 {
3158 le = symtab->linetable->item;
3159 for (ln = symtab->linetable->nitems ;ln > 0; ln--, le++)
3160 {
3161 lnum = le->line >> 3;
3162 if (lnum >= ltable_size)
3163 {
3164 char *new_ltable;
3165 new_ltable = (char *)realloc (ltable, ltable_size*2);
3166 memset (new_ltable + ltable_size, 0, ltable_size);
3167 ltable_size *= 2;
3168 if (new_ltable == NULL)
3169 {
3170 sprintf(msg, "Out of memory.");
3171 Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
3172 free (ltable);
3173 fclose (fp);
3174 return TCL_ERROR;
3175 }
3176 ltable = new_ltable;
3177 }
3178 ltable[lnum] |= 1 << (le->line % 8);
3179 }
3180 }
11f91b2b 3181
929db6e5
EZ		 3182 /* create an object with enough space, then grab its */
3183 /* buffer and sprintf directly into it. */
3184 a[0] = Tcl_NewStringObj (ltable, 1024);
3185 a[1] = Tcl_NewListObj(0,NULL);
3186 buf = a[0]->bytes;
3187 b[0] = Tcl_NewStringObj (ltable,1024);
3188 b[1] = Tcl_NewStringObj ("source_tag", -1);
3189 Tcl_IncrRefCount (b[0]);
3190 Tcl_IncrRefCount (b[1]);
3191 line = b[0]->bytes + 1;
3192 strcpy(b[0]->bytes,"\t");
3193
3194 ln = 1;
3195 while (fgets (line, 980, fp))
3196 {
3197 if (linenumbers)
3198 {
3199 if (ltable[ln >> 3] & (1 << (ln % 8)))
390ca26a
KS		 3200 {
3201 sprintf (buf,"%s insert end {-\t%d} break_tag", widget, ln);
3202 a[0]->length = strlen (buf);
3203 }
929db6e5 3204 else
390ca26a
KS		 3205 {
3206 sprintf (buf,"%s insert end { \t%d} \"\"", widget, ln);
3207 a[0]->length = strlen (buf);
3208 }
929db6e5
EZ		 3209 }
3210 else
3211 {
3212 if (ltable[ln >> 3] & (1 << (ln % 8)))
390ca26a
KS		 3213 {
3214 sprintf (buf,"%s insert end {-\t} break_tag", widget);
3215 a[0]->length = strlen (buf);
3216 }
929db6e5 3217 else
390ca26a
KS		 3218 {
3219 sprintf (buf,"%s insert end { \t} \"\"", widget);
3220 a[0]->length = strlen (buf);
3221 }
929db6e5
EZ		 3222 }
3223 b[0]->length = strlen(b[0]->bytes);
3224 Tcl_SetListObj(a[1],2,b);
3225 cmd = Tcl_ConcatObj(2,a);
3226 Tcl_EvalObj (interp, cmd);
3227 Tcl_DecrRefCount (cmd);
3228 ln++;
3229 }
3230 Tcl_DecrRefCount (b[0]);
3231 Tcl_DecrRefCount (b[0]);
3232 Tcl_DecrRefCount (b[1]);
3233 Tcl_DecrRefCount (b[1]);
3234 free (ltable);
3235 fclose (fp);
11f91b2b
KS		 3236 return TCL_OK;
3237}
3238
929db6e5
EZ		 3239/* at some point make these static in breakpoint.c and move GUI code there */
3240extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
3241extern void set_breakpoint_count (int);
3242extern int breakpoint_count;
3243
3244/* set a breakpoint by source file and line number */
3245/* flags are as follows: */
3246/* least significant 2 bits are disposition, rest is */
3247/* type (normally 0).
3248
3249enum bptype {
3250 bp_breakpoint, Normal breakpoint
3251 bp_hardware_breakpoint, Hardware assisted breakpoint
3252}
3253
3254Disposition of breakpoint. Ie: what to do after hitting it.
3255enum bpdisp {
3256 del, Delete it
3257 del_at_next_stop, Delete at next stop, whether hit or not
3258 disable, Disable it
3259 donttouch Leave it alone
3260 };
3261*/
3262
3263static int
3264gdb_set_bp (clientData, interp, objc, objv)
3265 ClientData clientData;
3266 Tcl_Interp *interp;
3267 int objc;
3268 Tcl_Obj *CONST objv[];
3269
11f91b2b 3270{
929db6e5
EZ		 3271 struct symtab_and_line sal;
3272 int line, flags, ret;
3273 struct breakpoint *b;
3274 char buf[64];
3275 Tcl_Obj *a[5], *cmd;
e0f7db02 3276
929db6e5 3277 if (objc != 4)
e0f7db02 3278 {
929db6e5
EZ		 3279 Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
3280 return TCL_ERROR;
e0f7db02 3281 }
11f91b2b 3282
929db6e5
EZ		 3283 sal.symtab = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL));
3284 if (sal.symtab == NULL)
3285 return TCL_ERROR;
3286
3287 if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR)
3288 return TCL_ERROR;
3289
3290 if (Tcl_GetIntFromObj( interp, objv[3], &flags) == TCL_ERROR)
3291 return TCL_ERROR;
3292
3293 sal.line = line;
3294 sal.pc = find_line_pc (sal.symtab, sal.line);
3295 if (sal.pc == 0)
3296 return TCL_ERROR;
3297
3298 sal.section = find_pc_overlay (sal.pc);
3299 b = set_raw_breakpoint (sal);
3300 set_breakpoint_count (breakpoint_count + 1);
3301 b->number = breakpoint_count;
3302 b->type = flags >> 2;
3303 b->disposition = flags & 3;
3304
3305 /* FIXME: this won't work for duplicate basenames! */
3306 sprintf (buf, "%s:%d", basename(Tcl_GetStringFromObj( objv[1], NULL)), line);
3307 b->addr_string = strsave (buf);
3308
3309 /* now send notification command back to GUI */
3310 sprintf (buf, "0x%x", sal.pc);
3311 a[0] = Tcl_NewStringObj ("gdbtk_tcl_breakpoint create", -1);
3312 a[1] = Tcl_NewIntObj (b->number);
3313 a[2] = Tcl_NewStringObj (buf, -1);
3314 a[3] = objv[2];
3315 a[4] = Tcl_NewListObj (1,&objv[1]);
3316 cmd = Tcl_ConcatObj(5,a);
3317 ret = Tcl_EvalObj (interp, cmd);
3318 Tcl_DecrRefCount (cmd);
3319 return ret;
11f91b2b 3320}
4f17e6eb 3321
929db6e5
EZ		 3322#ifdef __CYGWIN32__
3323/* The whole timer idea is an easy one, but POSIX does not appear to have
3324 some sort of interval timer requirement. Consequently, we cannot rely
3325 on cygwin32 to always deliver the timer's signal. This is especially
3326 painful given that all serial I/O will block the timer right now. */
3327static void
3328gdbtk_annotate_starting ()
11f91b2b 3329{
929db6e5
EZ		 3330 /* TclDebug ("### STARTING ###"); */
3331 gdbtk_start_timer ();
11f91b2b
KS		 3332}
3333
929db6e5
EZ		 3334static void
3335gdbtk_annotate_stopped ()
11f91b2b 3336{
929db6e5
EZ		 3337 /* TclDebug ("### STOPPED ###"); */
3338 gdbtk_stop_timer ();
e0f7db02
KS		 3339}
3340
929db6e5
EZ		 3341static void
3342gdbtk_annotate_exited ()
0776b0b0 3343{
929db6e5
EZ		 3344 /* TclDebug ("### EXITED ###"); */
3345 gdbtk_stop_timer ();
0776b0b0
MH		 3346}
3347
a5f4fbff 3348static void
929db6e5 3349gdbtk_annotate_signalled ()
a5f4fbff 3350{
929db6e5
EZ		 3351 /* TclDebug ("### SIGNALLED ###"); */
3352 gdbtk_stop_timer ();
a5f4fbff 3353}
929db6e5 3354#endif
0776b0b0 3355
3f37b696 3356/* Come here during initialize_all_files () */
754e5da2
SG		 3357
3358void
3359_initialize_gdbtk ()
3360{
c5197511
SG		 3361 if (use_windows)
3362 {
3363 /* Tell the rest of the world that Gdbtk is now set up. */
754e5da2 3364
c5197511
SG		 3365 init_ui_hook = gdbtk_init;
3366 }
754e5da2 3367}
GDB Binutils - Deliverables
This page took 0.307565 seconds and 4 git commands to generate.