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