- for (i=0; i < nbytes; i+= size)
- {
- if ( i >= rnum)
- {
- fputs_unfiltered ("N/A ", gdb_stdout);
- if (aschar)
- for ( j = 0; j < size; j++)
- *bptr++ = 'X';
- }
- else
- {
- print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
- fputs_unfiltered (" ", gdb_stdout);
- if (aschar)
- {
- for ( j = 0; j < size; j++)
- {
- c = *cptr++;
- if (c < 32 || c > 126)
- c = aschar;
- if (c == '"')
- *bptr++ = '\\';
- *bptr++ = c;
- }
- }
- }
-
- mptr += size;
- bc += size;
-
- if (aschar && (bc >= bpr))
- {
- /* end of row. print it and reset variables */
- bc = 0;
- *bptr++ = '"';
- *bptr++ = ' ';
- *bptr = 0;
- fputs_unfiltered (buff, gdb_stdout);
- bptr = &buff[1];
- }
- }
-
- free (mbuf);
- return TCL_OK;
-}
-
-static int
-map_arg_registers (argc, argv, func, argp)
- int argc;
- char *argv[];
- void (*func) PARAMS ((int regnum, void *argp));
- void *argp;
-{
- int regnum;
-
- /* Note that the test for a valid register must include checking the
- reg_names array because NUM_REGS may be allocated for the union of the
- register sets within a family of related processors. In this case, the
- trailing entries of reg_names will change depending upon the particular
- processor being debugged. */
-
- if (argc == 0) /* No args, just do all the regs */
- {
- for (regnum = 0;
- regnum < NUM_REGS
- && reg_names[regnum] != NULL
- && *reg_names[regnum] != '\000';
- regnum++)
- func (regnum, argp);
-
- return TCL_OK;
- }
-
- /* Else, list of register #s, just do listed regs */
- for (; argc > 0; argc--, argv++)
- {
- regnum = atoi (*argv);
-
- if (regnum >= 0
- && regnum < NUM_REGS
- && reg_names[regnum] != NULL
- && *reg_names[regnum] != '\000')
- func (regnum, argp);
- else
- error ("bad register number");
- }
-
- return TCL_OK;
-}
-
-static void
-get_register_name (regnum, argp)
- int regnum;
- void *argp; /* Ignored */
-{
- Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
-}
-
-/* This implements the TCL command `gdb_regnames', which returns a list of
- all of the register names. */
-
-static int
-gdb_regnames (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- argc--;
- argv++;
-
- return map_arg_registers (argc, argv, get_register_name, NULL);
-}
-
-#ifndef REGISTER_CONVERTIBLE
-#define REGISTER_CONVERTIBLE(x) (0 != 0)
-#endif
-
-#ifndef REGISTER_CONVERT_TO_VIRTUAL
-#define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
-#endif
-
-#ifndef INVALID_FLOAT
-#define INVALID_FLOAT(x, y) (0 != 0)
-#endif
-
-static void
-get_register (regnum, fp)
- int regnum;
- void *fp;
-{
- char raw_buffer[MAX_REGISTER_RAW_SIZE];
- char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
- int format = (int)fp;
-
- if (format == 'N')
- format = 0;
-
- if (read_relative_register_raw_bytes (regnum, raw_buffer))
- {
- Tcl_DStringAppendElement (result_ptr, "Optimized out");
- return;
- }
-
- /* Convert raw data to virtual format if necessary. */
-
- if (REGISTER_CONVERTIBLE (regnum))
- {
- REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
- raw_buffer, virtual_buffer);
- }
- else
- memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
-
- if (format == 'r')
- {
- int j;
- printf_filtered ("0x");
- for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
- {
- register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
- : REGISTER_RAW_SIZE (regnum) - 1 - j;
- printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
- }
- }
- else
- val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
- gdb_stdout, format, 1, 0, Val_pretty_default);
-
- Tcl_DStringAppend (result_ptr, " ", -1);
-}
-
-static int
-get_pc_register (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- sprintf(interp->result,"0x%llx",(long long)read_register(PC_REGNUM));
- return TCL_OK;
-}
-
-static int
-gdb_fetch_registers (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- int format;
-
- if (argc < 2)
- error ("wrong # args");
-
- argc -= 2;
- argv++;
- format = **argv++;
-
- return map_arg_registers (argc, argv, get_register, (void *) format);
-}
-
-/* This contains the previous values of the registers, since the last call to
- gdb_changed_register_list. */
-
-static char old_regs[REGISTER_BYTES];
-
-static void
-register_changed_p (regnum, argp)
- int regnum;
- void *argp; /* Ignored */
-{
- char raw_buffer[MAX_REGISTER_RAW_SIZE];
-
- if (read_relative_register_raw_bytes (regnum, raw_buffer))
- return;
-
- if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
- REGISTER_RAW_SIZE (regnum)) == 0)
- return;
-
- /* Found a changed register. Save new value and return its number. */
-
- memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
- REGISTER_RAW_SIZE (regnum));
-
- dsprintf_append_element (result_ptr, "%d", regnum);
-}
-
-static int
-gdb_changed_register_list (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- argc--;
- argv++;
-
- return map_arg_registers (argc, argv, register_changed_p, NULL);
-}
-\f
-/* This implements the tcl command "gdb_immediate", which does exactly
- the same thing as gdb_cmd, except NONE of its outut is buffered. */
-/* This will also ALWAYS cause the busy,update, and idle hooks to be
- called, contrasted with gdb_cmd, which NEVER calls them. */
-static int
-gdb_immediate_command (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- Tcl_DString *save_ptr = NULL;
-
- if (argc != 2)
- error ("wrong # args");
-
- if (running_now || load_in_progress)
- return TCL_OK;
-
- No_Update = 0;
-
- Tcl_DStringAppend (result_ptr, "", -1);
- save_ptr = result_ptr;
- result_ptr = NULL;
-
- execute_command (argv[1], 1);
-
- bpstat_do_actions (&stop_bpstat);
-
- result_ptr = save_ptr;
-
- return TCL_OK;
-}
-
-/* This implements the TCL command `gdb_cmd', which sends its argument into
- the GDB command scanner. */
-/* This command will never cause the update, idle and busy hooks to be called
- within the GUI. */
-static int
-gdb_cmd (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- Tcl_DString *save_ptr = NULL;
-
- if (argc < 2)
- error ("wrong # args");
-
- if (running_now || load_in_progress)
- return TCL_OK;
-
- No_Update = 1;
-
- /* for the load instruction (and possibly others later) we
- set result_ptr to NULL so gdbtk_fputs() will not buffer
- all the data until the command is finished. */
-
- if (strncmp ("load ", argv[1], 5) == 0
- || strncmp ("while ", argv[1], 6) == 0)
- {
- Tcl_DStringAppend (result_ptr, "", -1);
- save_ptr = result_ptr;
- result_ptr = NULL;
- load_in_progress = 1;
-
- /* On Windows, use timer interrupts so that the user can cancel
- the download. FIXME: We may have to do something on other
- systems. */
-#ifdef __CYGWIN32__
- gdbtk_start_timer ();
-#endif
- }
-
- execute_command (argv[1], 1);
-
-#ifdef __CYGWIN32__
- if (load_in_progress)
- gdbtk_stop_timer ();
-#endif
-
- load_in_progress = 0;
- bpstat_do_actions (&stop_bpstat);
-
- if (save_ptr)
- result_ptr = save_ptr;
-
- return TCL_OK;
-}
-
-/* Client of call_wrapper - this routine performs the actual call to
- the client function. */
-
-struct wrapped_call_args
-{
- Tcl_Interp *interp;
- Tcl_CmdProc *func;
- int argc;
- char **argv;
- int val;
-};
-
-static int
-wrapped_call (args)
- struct wrapped_call_args *args;
-{
- args->val = (*args->func) (args->func, args->interp, args->argc, args->argv);
- return 1;
-}
-
-/* This routine acts as a top-level for all GDB code called by tcl/Tk. It
- handles cleanups, and calls to return_to_top_level (usually via error).
- This is necessary in order to prevent a longjmp out of the bowels of Tk,
- possibly leaving things in a bad state. Since this routine can be called
- recursively, it needs to save and restore the contents of the jmp_buf as
- necessary. */
-
-static int
-call_wrapper (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- struct wrapped_call_args wrapped_args;
- Tcl_DString result, *old_result_ptr;
- Tcl_DString error_string, *old_error_string_ptr;
-
- Tcl_DStringInit (&result);
- old_result_ptr = result_ptr;
- result_ptr = &result;
-
- Tcl_DStringInit (&error_string);
- old_error_string_ptr = error_string_ptr;
- error_string_ptr = &error_string;
-
- wrapped_args.func = (Tcl_CmdProc *)clientData;
- wrapped_args.interp = interp;
- wrapped_args.argc = argc;
- wrapped_args.argv = argv;
- wrapped_args.val = 0;
-
- if (!catch_errors (wrapped_call, &wrapped_args, "", RETURN_MASK_ALL))
- {
- wrapped_args.val = TCL_ERROR; /* Flag an error for TCL */
-
-#ifdef __CYGWIN32__
- /* Make sure the timer interrupts are turned off. */
- if (gdbtk_timer_going)
- gdbtk_stop_timer ();
-#endif
-
- gdb_flush (gdb_stderr); /* Flush error output */
- gdb_flush (gdb_stdout); /* Sometimes error output comes here as well */
-
- /* In case of an error, we may need to force the GUI into idle
- mode because gdbtk_call_command may have bombed out while in
- the command routine. */
-
- running_now = 0;
- Tcl_Eval (interp, "gdbtk_tcl_idle");
- }
-
- /* do not suppress any errors -- a remote target could have errored */
- load_in_progress = 0;
-
- if (Tcl_DStringLength (&error_string) == 0)
- {
- Tcl_DStringResult (interp, &result);
- Tcl_DStringFree (&error_string);
- }
- else if (Tcl_DStringLength (&result) == 0)
- {
- Tcl_DStringResult (interp, &error_string);
- Tcl_DStringFree (&result);
- Tcl_DStringFree (&error_string);
- }
- else
- {
- Tcl_ResetResult (interp);
- Tcl_AppendResult (interp, Tcl_DStringValue (&result),
- Tcl_DStringValue (&error_string), (char *) NULL);
- Tcl_DStringFree (&result);
- Tcl_DStringFree (&error_string);
- }
-
- result_ptr = old_result_ptr;
- error_string_ptr = old_error_string_ptr;
-
-#ifdef _WIN32
- close_bfds ();
-#endif
-
- return wrapped_args.val;
-}
-
-static int
-comp_files (file1, file2)
- const char *file1[], *file2[];
-{
- return strcmp(*file1,*file2);
-}
-
-static int
-gdb_listfiles (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- struct objfile *objfile;
- struct partial_symtab *psymtab;
- struct symtab *symtab;
- char *lastfile, *pathname, **files;
- int files_size;
- int i, numfiles = 0, len = 0;
- Tcl_Obj *mylist;
-
- files_size = 1000;
- files = (char **) xmalloc (sizeof (char *) * files_size);
-
- if (objc > 2)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "Usage: gdb_listfiles ?pathname?");
- return TCL_ERROR;
- }
- else if (objc == 2)
- pathname = Tcl_GetStringFromObj (objv[1], &len);
-
- mylist = Tcl_NewListObj (0, NULL);
-
- ALL_PSYMTABS (objfile, psymtab)
- {
- if (numfiles == files_size)
- {
- files_size = files_size * 2;
- files = (char **) xrealloc (files, sizeof (char *) * files_size);
- }
- if (len == 0)
- {
- if (psymtab->filename)
- files[numfiles++] = basename(psymtab->filename);
- }
- else if (!strcmp(psymtab->filename,basename(psymtab->filename))
- || !strncmp(pathname,psymtab->filename,len))
- if (psymtab->filename)
- files[numfiles++] = basename(psymtab->filename);
- }
-
- ALL_SYMTABS (objfile, symtab)
- {
- if (numfiles == files_size)
- {
- files_size = files_size * 2;
- files = (char **) xrealloc (files, sizeof (char *) * files_size);
- }
- if (len == 0)
- {
- if (symtab->filename)
- files[numfiles++] = basename(symtab->filename);
- }
- else if (!strcmp(symtab->filename,basename(symtab->filename))
- || !strncmp(pathname,symtab->filename,len))
- if (symtab->filename)
- files[numfiles++] = basename(symtab->filename);
- }
-
- qsort (files, numfiles, sizeof(char *), comp_files);
-
- lastfile = "";
- for (i = 0; i < numfiles; i++)
- {
- if (strcmp(files[i],lastfile))
- Tcl_ListObjAppendElement (interp, mylist, Tcl_NewStringObj(files[i], -1));
- lastfile = files[i];
- }
- Tcl_SetObjResult (interp, mylist);
- free (files);
- return TCL_OK;
-}
-
-static int
-gdb_listfuncs (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- struct symtab *symtab;
- struct blockvector *bv;
- struct block *b;
- struct symbol *sym;
- char buf[128];
- int i,j;
-
- if (argc != 2)
- error ("wrong # args");
-
- symtab = full_lookup_symtab (argv[1]);
- if (!symtab)
- error ("No such file");
-
- bv = BLOCKVECTOR (symtab);
- for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
- {
- b = BLOCKVECTOR_BLOCK (bv, i);
- /* Skip the sort if this block is always sorted. */
- if (!BLOCK_SHOULD_SORT (b))
- sort_block_syms (b);
- for (j = 0; j < BLOCK_NSYMS (b); j++)
- {
- sym = BLOCK_SYM (b, j);
- if (SYMBOL_CLASS (sym) == LOC_BLOCK)
- {
-
- char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
- if (name)
- {
- sprintf (buf,"{%s} 1", name);
- }
- else
- sprintf (buf,"{%s} 0", SYMBOL_NAME(sym));
- Tcl_DStringAppendElement (result_ptr, buf);
- }
- }
- }
- return TCL_OK;
-}
-
-static int
-target_stop_wrapper (args)
- char * args;
-{
- target_stop ();
- return 1;
-}
-
-static int
-gdb_stop (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- if (target_stop)
- {
- catch_errors (target_stop_wrapper, NULL, "",
- RETURN_MASK_ALL);
- }
- else
- quit_flag = 1; /* hope something sees this */
-
- return TCL_OK;
-}
-
-/* Prepare to accept a new executable file. This is called when we
- want to clear away everything we know about the old file, without
- asking the user. The Tcl code will have already asked the user if
- necessary. After this is called, we should be able to run the
- `file' command without getting any questions. */
-
-static int
-gdb_clear_file (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- if (inferior_pid != 0 && target_has_execution)
- {
- if (attach_flag)
- target_detach (NULL, 0);
- else
- target_kill ();
- }
-
- if (target_has_execution)
- pop_target ();
-
- symbol_file_command (NULL, 0);
-
- /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
- clear it here. FIXME: This seems like an abstraction violation
- somewhere. */
- stop_pc = 0;
-
- return TCL_OK;
-}
-
-/* Ask the user to confirm an exit request. */
-
-static int
-gdb_confirm_quit (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- int ret;
-
- ret = quit_confirm ();
- Tcl_DStringAppendElement (result_ptr, ret ? "1" : "0");
- return TCL_OK;
-}
-
-/* Quit without asking for confirmation. */
-
-static int
-gdb_force_quit (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- quit_force ((char *) NULL, 1);
- return TCL_OK;
-}
-\f
-/* This implements the TCL command `gdb_disassemble'. */
-
-static int
-gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
- bfd_vma memaddr;
- bfd_byte *myaddr;
- int len;
- disassemble_info *info;
-{
- extern struct target_ops exec_ops;
- int res;
-
- errno = 0;
- res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
-
- if (res == len)
- return 0;
- else
- if (errno == 0)
- return EIO;
- else
- return errno;
-}
-
-/* We need a different sort of line table from the normal one cuz we can't
- depend upon implicit line-end pc's for lines. This is because of the
- reordering we are about to do. */
-
-struct my_line_entry {
- int line;
- CORE_ADDR start_pc;
- CORE_ADDR end_pc;
-};
-
-static int
-compare_lines (mle1p, mle2p)
- const PTR mle1p;
- const PTR mle2p;
-{
- struct my_line_entry *mle1, *mle2;
- int val;
-
- mle1 = (struct my_line_entry *) mle1p;
- mle2 = (struct my_line_entry *) mle2p;
-
- val = mle1->line - mle2->line;
-
- if (val != 0)
- return val;
-
- return mle1->start_pc - mle2->start_pc;
-}
-
-static int
-gdb_disassemble (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- CORE_ADDR pc, low, high;
- int mixed_source_and_assembly;
- static disassemble_info di;
- static int di_initialized;
-
- if (! di_initialized)
- {
- INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
- (fprintf_ftype) fprintf_unfiltered);
- di.flavour = bfd_target_unknown_flavour;
- di.memory_error_func = dis_asm_memory_error;
- di.print_address_func = dis_asm_print_address;
- di_initialized = 1;
- }
-
- di.mach = tm_print_insn_info.mach;
- if (TARGET_BYTE_ORDER == BIG_ENDIAN)
- di.endian = BFD_ENDIAN_BIG;
- else
- di.endian = BFD_ENDIAN_LITTLE;
-
- if (argc != 3 && argc != 4)
- error ("wrong # args");
-
- if (strcmp (argv[1], "source") == 0)
- mixed_source_and_assembly = 1;
- else if (strcmp (argv[1], "nosource") == 0)
- mixed_source_and_assembly = 0;
- else
- error ("First arg must be 'source' or 'nosource'");
-
- low = parse_and_eval_address (argv[2]);
-
- if (argc == 3)
- {
- if (find_pc_partial_function (low, NULL, &low, &high) == 0)
- error ("No function contains specified address");
- }
- else
- high = parse_and_eval_address (argv[3]);
-
- /* If disassemble_from_exec == -1, then we use the following heuristic to
- determine whether or not to do disassembly from target memory or from the
- exec file:
-
- If we're debugging a local process, read target memory, instead of the
- exec file. This makes disassembly of functions in shared libs work
- correctly.
-
- Else, we're debugging a remote process, and should disassemble from the
- exec file for speed. However, this is no good if the target modifies its
- code (for relocation, or whatever).
- */
-
- if (disassemble_from_exec == -1)
- if (strcmp (target_shortname, "child") == 0
- || strcmp (target_shortname, "procfs") == 0
- || strcmp (target_shortname, "vxprocess") == 0)
- disassemble_from_exec = 0; /* It's a child process, read inferior mem */
- else
- disassemble_from_exec = 1; /* It's remote, read the exec file */
-
- if (disassemble_from_exec)
- di.read_memory_func = gdbtk_dis_asm_read_memory;
- else
- di.read_memory_func = dis_asm_read_memory;
-
- /* If just doing straight assembly, all we need to do is disassemble
- everything between low and high. If doing mixed source/assembly, we've
- got a totally different path to follow. */
-
- if (mixed_source_and_assembly)
- { /* Come here for mixed source/assembly */
- /* The idea here is to present a source-O-centric view of a function to
- the user. This means that things are presented in source order, with
- (possibly) out of order assembly immediately following. */
- struct symtab *symtab;
- struct linetable_entry *le;
- int nlines;
- int newlines;
- struct my_line_entry *mle;
- struct symtab_and_line sal;
- int i;
- int out_of_order;
- int next_line;
-
- symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
-
- if (!symtab)
- goto assembly_only;
-
-/* First, convert the linetable to a bunch of my_line_entry's. */
-
- le = symtab->linetable->item;
- nlines = symtab->linetable->nitems;
-
- if (nlines <= 0)
- goto assembly_only;
-
- mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
-
- out_of_order = 0;
-
-/* Copy linetable entries for this function into our data structure, creating
- end_pc's and setting out_of_order as appropriate. */
-
-/* First, skip all the preceding functions. */
-
- for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
-
-/* Now, copy all entries before the end of this function. */
-
- newlines = 0;
- for (; i < nlines - 1 && le[i].pc < high; i++)
- {
- if (le[i].line == le[i + 1].line
- && le[i].pc == le[i + 1].pc)
- continue; /* Ignore duplicates */
-
- mle[newlines].line = le[i].line;
- if (le[i].line > le[i + 1].line)
- out_of_order = 1;
- mle[newlines].start_pc = le[i].pc;
- mle[newlines].end_pc = le[i + 1].pc;
- newlines++;
- }
-
-/* If we're on the last line, and it's part of the function, then we need to
- get the end pc in a special way. */
-
- if (i == nlines - 1
- && le[i].pc < high)
- {
- mle[newlines].line = le[i].line;
- mle[newlines].start_pc = le[i].pc;
- sal = find_pc_line (le[i].pc, 0);
- mle[newlines].end_pc = sal.end;
- newlines++;
- }
-
-/* Now, sort mle by line #s (and, then by addresses within lines). */
-
- if (out_of_order)
- qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
-
-/* Now, for each line entry, emit the specified lines (unless they have been
- emitted before), followed by the assembly code for that line. */
-
- next_line = 0; /* Force out first line */
- for (i = 0; i < newlines; i++)
- {
-/* Print out everything from next_line to the current line. */
-
- if (mle[i].line >= next_line)
- {
- if (next_line != 0)
- print_source_lines (symtab, next_line, mle[i].line + 1, 0);
- else
- print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
-
- next_line = mle[i].line + 1;
- }
-
- for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
- {
- QUIT;
- fputs_unfiltered (" ", gdb_stdout);
- print_address (pc, gdb_stdout);
- fputs_unfiltered (":\t ", gdb_stdout);
- pc += (*tm_print_insn) (pc, &di);
- fputs_unfiltered ("\n", gdb_stdout);
- }
- }
- }
- else
- {
-assembly_only:
- for (pc = low; pc < high; )
- {
- QUIT;
- fputs_unfiltered (" ", gdb_stdout);
- print_address (pc, gdb_stdout);
- fputs_unfiltered (":\t ", gdb_stdout);
- pc += (*tm_print_insn) (pc, &di);
- fputs_unfiltered ("\n", gdb_stdout);
- }
- }
-
- gdb_flush (gdb_stdout);
-
- return TCL_OK;
-}
-\f
-static void
-tk_command (cmd, from_tty)
- char *cmd;
- int from_tty;
-{
- int retval;
- char *result;
- struct cleanup *old_chain;
-
- /* Catch case of no argument, since this will make the tcl interpreter dump core. */
- if (cmd == NULL)
- error_no_arg ("tcl command to interpret");
-
- retval = Tcl_Eval (interp, cmd);
-
- result = strdup (interp->result);
-
- old_chain = make_cleanup (free, result);
-
- if (retval != TCL_OK)
- error (result);
-
- printf_unfiltered ("%s\n", result);
-
- do_cleanups (old_chain);
-}
-
-static void
-cleanup_init (ignored)
- int ignored;
-{
- if (interp != NULL)
- Tcl_DeleteInterp (interp);
- interp = NULL;
-}
-
-/* Come here during long calculations to check for GUI events. Usually invoked
- via the QUIT macro. */
-
-static void
-gdbtk_interactive ()
-{
- /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
-}
-
-/* Come here when there is activity on the X file descriptor. */
-
-static void
-x_event (signo)
- int signo;
-{
- static int in_x_event = 0;
- static Tcl_Obj *varname = NULL;
-
- if (in_x_event || in_fputs)
- return;
-
- in_x_event = 1;
-
- /* Process pending events */
- while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
- ;
-
- if (load_in_progress)
- {
- int val;
- if (varname == NULL)
- {
- Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
- varname = Tcl_ObjGetVar2(interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
- }
- if ((Tcl_GetIntFromObj(interp,varname,&val) == TCL_OK) && val)
- {
- quit_flag = 1;
-#ifdef REQUEST_QUIT
- REQUEST_QUIT;
-#else
- if (immediate_quit)
- quit ();
-#endif
- }
- }
- in_x_event = 0;
-}
-
-#ifdef __CYGWIN32__
-
-/* For Cygwin32, we use a timer to periodically check for Windows
- messages. FIXME: It would be better to not poll, but to instead
- rewrite the target_wait routines to serve as input sources.
- Unfortunately, that will be a lot of work. */
-static sigset_t nullsigmask;
-static struct sigaction act1, act2;
-static struct itimerval it_on, it_off;
-
-static void
-gdbtk_start_timer ()
-{
- static int first = 1;
- /*TclDebug ("Starting timer....");*/
- if (first)
- {
- /* first time called, set up all the structs */
- first = 0;
- sigemptyset (&nullsigmask);
-
- act1.sa_handler = x_event;
- act1.sa_mask = nullsigmask;
- act1.sa_flags = 0;
-
- act2.sa_handler = SIG_IGN;
- act2.sa_mask = nullsigmask;
- act2.sa_flags = 0;
-
- it_on.it_interval.tv_sec = 0;
- it_on.it_interval.tv_usec = 500000; /* .5 sec */
- it_on.it_value.tv_sec = 0;
- it_on.it_value.tv_usec = 500000;
-
- it_off.it_interval.tv_sec = 0;
- it_off.it_interval.tv_usec = 0;
- it_off.it_value.tv_sec = 0;
- it_off.it_value.tv_usec = 0;
- }
- sigaction (SIGALRM, &act1, NULL);
- setitimer (ITIMER_REAL, &it_on, NULL);
- gdbtk_timer_going = 1;
-}
-
-static void
-gdbtk_stop_timer ()
-{
- gdbtk_timer_going = 0;
- /*TclDebug ("Stopping timer.");*/
- setitimer (ITIMER_REAL, &it_off, NULL);
- sigaction (SIGALRM, &act2, NULL);
-}
-
-#endif
-
-/* This hook function is called whenever we want to wait for the
- target. */
-
-static int
-gdbtk_wait (pid, ourstatus)
- int pid;
- struct target_waitstatus *ourstatus;
-{
-#ifndef WINNT
- struct sigaction action;
- static sigset_t nullsigmask = {0};
-
-
-#ifndef SA_RESTART
- /* Needed for SunOS 4.1.x */
-#define SA_RESTART 0
-#endif
-
- action.sa_handler = x_event;
- action.sa_mask = nullsigmask;
- action.sa_flags = SA_RESTART;
- sigaction(SIGIO, &action, NULL);
-#endif /* WINNT */
-
- pid = target_wait (pid, ourstatus);
-
-#ifndef WINNT
- action.sa_handler = SIG_IGN;
- sigaction(SIGIO, &action, NULL);
-#endif
-
- return pid;
-}
-
-/* This is called from execute_command, and provides a wrapper around
- various command routines in a place where both protocol messages and
- user input both flow through. Mostly this is used for indicating whether
- the target process is running or not.
-*/
-
-static void
-gdbtk_call_command (cmdblk, arg, from_tty)
- struct cmd_list_element *cmdblk;
- char *arg;
- int from_tty;
-{
- running_now = 0;
- if (cmdblk->class == class_run || cmdblk->class == class_trace)
- {
- running_now = 1;
- if (!No_Update)
- Tcl_Eval (interp, "gdbtk_tcl_busy");
- (*cmdblk->function.cfunc)(arg, from_tty);
- running_now = 0;
- if (!No_Update)
- Tcl_Eval (interp, "gdbtk_tcl_idle");
- }
- else
- (*cmdblk->function.cfunc)(arg, from_tty);
-}
-
-/* This function is called instead of gdb's internal command loop. This is the
- last chance to do anything before entering the main Tk event loop. */
-
-static void
-tk_command_loop ()
-{
- extern GDB_FILE *instream;
-
- /* We no longer want to use stdin as the command input stream */
- instream = NULL;
-
- if (Tcl_Eval (interp, "gdbtk_tcl_preloop") != TCL_OK)
- {
- char *msg;
-
- /* Force errorInfo to be set up propertly. */
- Tcl_AddErrorInfo (interp, "");
-
- msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
-#ifdef _WIN32
- MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
-#else
- fputs_unfiltered (msg, gdb_stderr);
-#endif
- }
-
-#ifdef _WIN32
- close_bfds ();
-#endif
-
- Tk_MainLoop ();
-}
-
-/* gdbtk_init installs this function as a final cleanup. */
-
-static void
-gdbtk_cleanup (dummy)
- PTR dummy;
-{
-#ifdef IDE
- struct ide_event_handle *h = (struct ide_event_handle *) dummy;
-
- ide_interface_deregister_all (h);
-#endif
- Tcl_Finalize ();
-}
-
-/* Initialize gdbtk. */
-
-static void
-gdbtk_init ( argv0 )
- char *argv0;
-{
- struct cleanup *old_chain;
- char *lib, *gdbtk_lib, *gdbtk_lib_tmp, *gdbtk_file;
- int i, found_main;
-#ifndef WINNT
- struct sigaction action;
- static sigset_t nullsigmask = {0};
-#endif
-#ifdef IDE
- /* start-sanitize-ide */
- struct ide_event_handle *h;
- const char *errmsg;
- char *libexecdir;
- /* end-sanitize-ide */
-#endif
-
- /* If there is no DISPLAY environment variable, Tk_Init below will fail,
- causing gdb to abort. If instead we simply return here, gdb will
- gracefully degrade to using the command line interface. */
-
-#ifndef WINNT
- if (getenv ("DISPLAY") == NULL)
- return;
-#endif
-
- old_chain = make_cleanup (cleanup_init, 0);
-
- /* First init tcl and tk. */
- Tcl_FindExecutable (argv0);
- interp = Tcl_CreateInterp ();
-
-#ifdef TCL_MEM_DEBUG
- Tcl_InitMemory (interp);
-#endif
-
- if (!interp)
- error ("Tcl_CreateInterp failed");
-
- if (Tcl_Init(interp) != TCL_OK)
- error ("Tcl_Init failed: %s", interp->result);
-
-#ifndef IDE
- /* For the IDE we register the cleanup later, after we've
- initialized events. */
- make_final_cleanup (gdbtk_cleanup, NULL);
-#endif
-
- /* Initialize the Paths variable. */
- if (ide_initialize_paths (interp, "gdbtcl") != TCL_OK)
- error ("ide_initialize_paths failed: %s", interp->result);
-
-#ifdef IDE
- /* start-sanitize-ide */
- /* Find the directory where we expect to find idemanager. We ignore
- errors since it doesn't really matter if this fails. */
- libexecdir = Tcl_GetVar2 (interp, "Paths", "libexecdir", TCL_GLOBAL_ONLY);
-
- IluTk_Init ();
-
- h = ide_event_init_from_environment (&errmsg, libexecdir);
- make_final_cleanup (gdbtk_cleanup, h);
- if (h == NULL)
- {
- Tcl_AppendResult (interp, "can't initialize event system: ", errmsg,
- (char *) NULL);
- fprintf(stderr, "WARNING: ide_event_init_client failed: %s\n", interp->result);
-
- Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
- }
- else
- {
- if (ide_create_tclevent_command (interp, h) != TCL_OK)
- error ("ide_create_tclevent_command failed: %s", interp->result);
-
- if (ide_create_edit_command (interp, h) != TCL_OK)
- error ("ide_create_edit_command failed: %s", interp->result);
-
- if (ide_create_property_command (interp, h) != TCL_OK)
- error ("ide_create_property_command failed: %s", interp->result);
-
- if (ide_create_build_command (interp, h) != TCL_OK)
- error ("ide_create_build_command failed: %s", interp->result);
-
- if (ide_create_window_register_command (interp, h, "gdb-restore")
- != TCL_OK)
- error ("ide_create_window_register_command failed: %s",
- interp->result);
-
- if (ide_create_window_command (interp, h) != TCL_OK)
- error ("ide_create_window_command failed: %s", interp->result);
-
- if (ide_create_exit_command (interp, h) != TCL_OK)
- error ("ide_create_exit_command failed: %s", interp->result);
-
- if (ide_create_help_command (interp) != TCL_OK)
- error ("ide_create_help_command failed: %s", interp->result);
-
- /*
- if (ide_initialize (interp, "gdb") != TCL_OK)
- error ("ide_initialize failed: %s", interp->result);
- */
-
- Tcl_SetVar (interp, "GDBTK_IDE", "1", 0);
- }
- /* end-sanitize-ide */
-#else
- Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
-#endif /* IDE */
-
- /* We don't want to open the X connection until we've done all the
- IDE initialization. Otherwise, goofy looking unfinished windows
- pop up when ILU drops into the TCL event loop. */
-
- if (Tk_Init(interp) != TCL_OK)
- error ("Tk_Init failed: %s", interp->result);
-
- if (Itcl_Init(interp) == TCL_ERROR)
- error ("Itcl_Init failed: %s", interp->result);
-
- if (Tix_Init(interp) != TCL_OK)
- error ("Tix_Init failed: %s", interp->result);
-
-#ifdef __CYGWIN32__
- if (ide_create_messagebox_command (interp) != TCL_OK)