* generic/gdbtk-cmds.c: Put on diet. All breakpoint-,

	tracepoint-, register-, and stack-related functions moved
	into separate files.
	(call_wrapper): Renamed to "gdbtk_call_wrapper" and export.
	Update all callers.
	* generic/gdbtk.h: Move all breakpoint-related stuff into
	gdbtk-bp.c.
	Remove declaration for "call_wrapper". Now in gdbtk-cmds.h
	(and called "gdbtk_call_wrapper").
	* generic/gdbtk-varobj.c: Include "gdbtk-cmds.h".
	* generic/gdbtk-cmds.h: New file.
	* generic/gdbtk-bp.c: New file.
	* generic/gdbtk-register.c: New file.
	* generic/gdbtk-stack.c: New file.

1 files changed, 373 insertions, 0 deletions

diff --git a/gdb/gdbtk/generic/gdbtk-register.c b/gdb/gdbtk/generic/gdbtk-register.c
new file mode 100644
index 00000000000..e23c8ef2b11
--- /dev/null
+++ b/gdb/gdbtk/generic/gdbtk-register.c
@@ -0,0 +1,373 @@
+/* Tcl/Tk command definitions for Insight - Registers
+   Copyright 2001 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.  */
+
+#include "defs.h"
+#include "frame.h"
+#include "value.h"
+
+#include <tcl.h>
+#include "gdbtk.h"
+#include "gdbtk-cmds.h"
+
+/* This contains the previous values of the registers, since the last call to
+   gdb_changed_register_list.  */
+
+static char *old_regs;
+
+static int gdb_changed_register_list (ClientData, Tcl_Interp *, int,
+				      Tcl_Obj * CONST[]);
+static int gdb_fetch_registers (ClientData, Tcl_Interp *, int,
+				Tcl_Obj * CONST[]);
+static int gdb_regnames (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
+static int get_pc_register (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
+static void get_register (int, void *);
+static void get_register_name (int, void *);
+static int map_arg_registers (int, Tcl_Obj * CONST[],
+			      void (*)(int, void *), void *);
+static void register_changed_p (int, void *);
+static void setup_architecture_data (void);
+
+int
+Gdbtk_Register_Init (Tcl_Interp *interp)
+{
+  Tcl_CreateObjCommand (interp, "gdb_changed_register_list", gdbtk_call_wrapper,
+			gdb_changed_register_list, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_fetch_registers", gdbtk_call_wrapper,
+			gdb_fetch_registers, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_regnames", gdbtk_call_wrapper, gdb_regnames,
+			NULL);
+  Tcl_CreateObjCommand (interp, "gdb_pc_reg", gdbtk_call_wrapper, get_pc_register,
+			NULL);
+
+  /* Register/initialize any architecture specific data */
+  setup_architecture_data ();
+  register_gdbarch_swap (&old_regs, sizeof (old_regs), NULL);
+  register_gdbarch_swap (NULL, 0, setup_architecture_data);
+
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_changed_register_list"
+ * It takes a list of registers, and returns a list of
+ * the registers on that list that have changed since the last
+ * time the proc was called.
+ *
+ * Tcl Arguments:
+ *    A list of registers.
+ * Tcl Result:
+ *    A list of changed registers.
+ */
+static int
+gdb_changed_register_list (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  objc--;
+  objv++;
+
+  return map_arg_registers (objc, objv, register_changed_p, NULL);
+}
+
+/* This implements the tcl command gdb_fetch_registers
+ * Pass it a list of register names, and it will
+ * return their values as a list.
+ *
+ * Tcl Arguments:
+ *    format: The format string for printing the values
+ *    args: the registers to look for
+ * Tcl Result:
+ *    A list of their values.
+ */
+static int
+gdb_fetch_registers (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int format, result;
+
+  if (objc < 2)
+    {
+      Tcl_WrongNumArgs (interp, 1, objv, "format ?register1 register2 ...?");
+      return TCL_ERROR;
+    }
+  objc -= 2;
+  objv++;
+  format = *(Tcl_GetStringFromObj (objv[0], NULL));
+  objv++;
+
+  if (objc != 1)
+    result_ptr->flags |= GDBTK_MAKES_LIST;    /* Output the results as a list */
+  result = map_arg_registers (objc, objv, get_register, (void *) format);
+  if (objc != 1)
+    result_ptr->flags &= ~GDBTK_MAKES_LIST;
+
+  return result;
+}
+
+/* This implements the TCL command `gdb_regnames'.  Its syntax is:
+
+   gdb_regnames [-numbers] [REGNUM ...]
+
+   Return a list containing the names of the registers whose numbers
+   are given by REGNUM ... .  If no register numbers are given, return
+   all the registers' names.
+
+   Note that some processors have gaps in the register numberings:
+   even if there is no register numbered N, there may still be a
+   register numbered N+1.  So if you call gdb_regnames with no
+   arguments, you can't assume that the N'th element of the result is
+   register number N.
+
+   Given the -numbers option, gdb_regnames returns, not a list of names,
+   but a list of pairs {NAME NUMBER}, where NAME is the register name,
+   and NUMBER is its number.  */
+static int
+gdb_regnames (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int numbers = 0;
+
+  objc--;
+  objv++;
+
+  if (objc >= 1)
+    {
+      char *s = Tcl_GetStringFromObj (objv[0], NULL);
+      if (STREQ (s, "-numbers"))
+	numbers = 1;
+      objc--;
+      objv++;
+    }
+
+  return map_arg_registers (objc, objv, get_register_name, &numbers);
+}
+
+/* This implements the tcl command get_pc_reg
+ * It returns the value of the PC register
+ *
+ * Tcl Arguments:
+ *    None
+ * Tcl Result:
+ *    The value of the pc register.
+ */
+static int
+get_pc_register (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  char *buff;
+
+  xasprintf (&buff, "0x%llx", (long long) read_register (PC_REGNUM));
+  Tcl_SetStringObj (result_ptr->obj_ptr, buff, -1);
+  free(buff);
+  return TCL_OK;
+}
+
+static void
+get_register (regnum, fp)
+     int regnum;
+     void *fp;
+{
+  struct type *reg_vtype;
+  char raw_buffer[MAX_REGISTER_RAW_SIZE];
+  char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
+  int format = (int) fp;
+  int optim;
+
+  if (format == 'N')
+    format = 0;
+
+  /* read_relative_register_raw_bytes returns a virtual frame pointer
+     (FRAME_FP (selected_frame)) if regnum == FP_REGNUM instead
+     of the real contents of the register. To get around this,
+     use get_saved_register instead. */
+  get_saved_register (raw_buffer, &optim, (CORE_ADDR *) NULL, selected_frame,
+		      regnum, (enum lval_type *) NULL);
+  if (optim)
+    {
+      Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+				Tcl_NewStringObj ("Optimized out", -1));
+      return;
+    }
+
+  /* Convert raw data to virtual format if necessary.  */
+
+  reg_vtype = REGISTER_VIRTUAL_TYPE (regnum);
+  if (REGISTER_CONVERTIBLE (regnum))
+    {
+      REGISTER_CONVERT_TO_VIRTUAL (regnum, reg_vtype,
+      				   raw_buffer, virtual_buffer);
+    }
+  else
+    memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
+
+  if (format == 'r')
+    {
+      int j;
+      char *ptr, buf[1024];
+
+      strcpy (buf, "0x");
+      ptr = buf + 2;
+      for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
+	{
+	  register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
+	  : REGISTER_RAW_SIZE (regnum) - 1 - j;
+	  sprintf (ptr, "%02x", (unsigned char) raw_buffer[idx]);
+	  ptr += 2;
+	}
+      fputs_filtered (buf, gdb_stdout);
+    }
+  else
+    if ((TYPE_CODE (reg_vtype) == TYPE_CODE_UNION)
+        && (strcmp (FIELD_NAME (TYPE_FIELD (reg_vtype, 0)), REGISTER_NAME (regnum)) == 0))
+      {
+        val_print (FIELD_TYPE (TYPE_FIELD (reg_vtype, 0)), virtual_buffer, 0, 0,
+	           gdb_stdout, format, 1, 0, Val_pretty_default);
+      }
+    else
+      val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, 0,
+	         gdb_stdout, format, 1, 0, Val_pretty_default);
+
+}
+
+static void
+get_register_name (regnum, argp)
+     int regnum;
+     void *argp;
+{
+  /* Non-zero if the caller wants the register numbers, too.  */
+  int numbers = * (int *) argp;
+  Tcl_Obj *name = Tcl_NewStringObj (REGISTER_NAME (regnum), -1);
+  Tcl_Obj *elt;
+
+  if (numbers)
+    {
+      /* Build a tuple of the form "{REGNAME NUMBER}", and append it to
+	 our result.  */
+      Tcl_Obj *array[2];
+
+      array[0] = name;
+      array[1] = Tcl_NewIntObj (regnum);
+      elt = Tcl_NewListObj (2, array);
+    }
+  else
+    elt = name;
+
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, elt);
+}
+
+/* This is a sort of mapcar function for operations on registers */
+
+static int
+map_arg_registers (objc, objv, func, argp)
+     int objc;
+     Tcl_Obj *CONST objv[];
+     void (*func) (int regnum, void *argp);
+     void *argp;
+{
+  int regnum, numregs;
+
+  /* Note that the test for a valid register must include checking the
+     REGISTER_NAME because NUM_REGS may be allocated for the union of
+     the register sets within a family of related processors.  In this
+     case, some entries of REGISTER_NAME will change depending upon
+     the particular processor being debugged.  */
+
+  numregs = NUM_REGS + NUM_PSEUDO_REGS;
+  
+  if (objc == 0)		/* No args, just do all the regs */
+    {
+      for (regnum = 0;
+	   regnum < numregs;
+	   regnum++)
+	{
+	  if (REGISTER_NAME (regnum) == NULL
+	      || *(REGISTER_NAME (regnum)) == '\0')
+	    continue;
+	  
+	  func (regnum, argp);
+	}
+      
+      return TCL_OK;
+    }
+
+  /* Else, list of register #s, just do listed regs */
+  for (; objc > 0; objc--, objv++)
+    {
+      if (Tcl_GetIntFromObj (NULL, *objv, &regnum) != TCL_OK)
+	{
+	  result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+	  return TCL_ERROR;
+	}
+
+      if (regnum >= 0
+	  && regnum < numregs
+	  && REGISTER_NAME (regnum) != NULL
+	  && *REGISTER_NAME (regnum) != '\000')
+	func (regnum, argp);
+      else
+	{
+	  Tcl_SetStringObj (result_ptr->obj_ptr, "bad register number", -1);
+	  return TCL_ERROR;
+	}
+    }
+
+  return TCL_OK;
+}
+
+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));
+
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (regnum));
+}
+
+static void
+setup_architecture_data ()
+{
+  /* don't trust REGISTER_BYTES to be zero. */
+  old_regs = xmalloc (REGISTER_BYTES + 1);
+  memset (old_regs, 0, REGISTER_BYTES + 1);
+}
+