1999-01-19 Fernando Nasser <fnasser@totem.to.cygnus.com>
[deliverable/binutils-gdb.git] / gdb / gdbtk-cmds.c
index 9620da30dfee64f59b57e8ea27915affc5c54f04..00199749d24f4c065cb7651ca13fb51be199dd38 100644 (file)
@@ -131,6 +131,18 @@ struct my_line_entry {
 
 static char old_regs[REGISTER_BYTES];
 
+/* These two lookup tables are used to translate the type & disposition fields
+   of the breakpoint structure (respectively) into something gdbtk understands.
+   They are also used in gdbtk-hooks.c */
+
+char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
+                             "finish", "watchpoint", "hardware watchpoint",
+                             "read watchpoint", "access watchpoint",
+                             "longjmp", "longjmp resume", "step resume",
+                             "through sigtramp", "watchpoint scope",
+                             "call dummy" };
+char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
+
 /*
  * These are routines we need from breakpoint.c.
  * at some point make these static in breakpoint.c and move GUI code there
@@ -140,6 +152,11 @@ extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
 extern void set_breakpoint_count (int);
 extern int breakpoint_count;
 
+/* This variable determines where memory used for disassembly is read from.
+ * See note in gdbtk.h for details.
+ */
+int disassemble_from_exec = -1;
+
 
 /*
  * Declarations for routines exported from this file
@@ -199,6 +216,7 @@ static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST [
 static int gdb_search PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
                               objv[]));
 static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_set_bp_addr PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static int gdb_find_bp_at_line PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static int gdb_find_bp_at_addr PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
@@ -302,6 +320,7 @@ Gdbtk_Init (interp)
   Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", call_wrapper,
                        gdb_search,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_set_bp", call_wrapper, gdb_set_bp,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_set_bp_addr", call_wrapper, gdb_set_bp_addr,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_find_bp_at_line", call_wrapper, gdb_find_bp_at_line,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_find_bp_at_addr", call_wrapper, gdb_find_bp_at_addr,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_get_trace_frame_num",
@@ -316,6 +335,10 @@ Gdbtk_Init (interp)
   Tcl_LinkVar (interp, "gdb_context_id",
                (char *) &gdb_context,
                TCL_LINK_INT | TCL_LINK_READ_ONLY);
+  
+  /* Determine where to disassemble from */
+  Tcl_LinkVar (gdbtk_interp, "disassemble-from-exec", (char *) &disassemble_from_exec,
+              TCL_LINK_INT);
 
   Tcl_PkgProvide(interp, "Gdbtk", GDBTK_VERSION);
   return TCL_OK;
@@ -614,7 +637,7 @@ gdb_eval (clientData, interp, objc, objv)
 
   expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL));
 
-  old_chain = make_cleanup (free_current_contents, &expr);
+  old_chain = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
 
   val = evaluate_expression (expr);
 
@@ -624,7 +647,8 @@ gdb_eval (clientData, interp, objc, objv)
    * the Tcl result.
    */
   
-  val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
+  val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
+            VALUE_EMBEDDED_OFFSET(val), VALUE_ADDRESS (val),
             gdb_stdout, 0, 0, 0, 0);
 
   do_cleanups (old_chain);
@@ -652,13 +676,23 @@ gdb_cmd (clientData, interp, objc, objv)
      int objc;
      Tcl_Obj *CONST objv[];
 {
-
+  int from_tty = 0;
+  
   if (objc < 2)
     {
       Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
       return TCL_ERROR;
     }
 
+  if (objc == 3)
+    {
+      if (Tcl_GetBooleanFromObj (NULL, objv[2], &from_tty) != TCL_OK) {
+       Tcl_SetStringObj (result_ptr->obj_ptr, "from_tty must be a boolean.",
+                         -1);
+       return TCL_ERROR;
+      }
+    }
+
   if (running_now || load_in_progress)
     return TCL_OK;
 
@@ -674,7 +708,7 @@ gdb_cmd (clientData, interp, objc, objv)
       load_in_progress = 1;
     }
 
-  execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
+  execute_command (Tcl_GetStringFromObj (objv[1], NULL), from_tty);
 
   if (load_in_progress)
     {
@@ -814,7 +848,7 @@ gdb_load_info (clientData, interp, objc, objv)
        Tcl_SetStringObj (result_ptr->obj_ptr, "Open failed", -1);
        return TCL_ERROR;
      }
-   old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
+   old_cleanups = make_cleanup ((make_cleanup_func) bfd_close, loadfile_bfd);
    
    if (!bfd_check_format (loadfile_bfd, bfd_object)) 
      {
@@ -1368,7 +1402,7 @@ gdb_search (clientData, interp, objc, objv)
 
   search_symbols (regexp, space, nfiles, files, &ss);
   if (ss != NULL)
-    old_chain = make_cleanup (free_search_symbols, ss);
+    old_chain = make_cleanup ((make_cleanup_func) free_search_symbols, ss);
 
   Tcl_SetListObj(result_ptr->obj_ptr, 0, NULL);  
 
@@ -1379,16 +1413,23 @@ gdb_search (clientData, interp, objc, objv)
       if (static_only && p->block != STATIC_BLOCK)
         continue;
 
-      elem = Tcl_NewListObj (0, NULL);
+      /* Strip off some C++ special symbols, like RTTI and global
+         constructors/destructors. */
+      if ((p->symbol != NULL && !STREQN (SYMBOL_NAME (p->symbol), "__tf", 4)
+           && !STREQN (SYMBOL_NAME (p->symbol), "_GLOBAL_", 8))
+          || p->msymbol != NULL)
+        {
+          elem = Tcl_NewListObj (0, NULL);
 
-      if (p->msymbol == NULL)
-        Tcl_ListObjAppendElement (interp, elem, 
-                                  Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->symbol), -1));
-      else
-        Tcl_ListObjAppendElement (interp, elem,
-                                  Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->msymbol), -1));
+          if (p->msymbol == NULL)
+            Tcl_ListObjAppendElement (interp, elem, 
+                                      Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->symbol), -1));
+          else
+            Tcl_ListObjAppendElement (interp, elem,
+                                      Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->msymbol), -1));
 
-      Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elem);
+          Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elem);
+        }
     }
   
   if (ss != NULL)
@@ -1502,17 +1543,17 @@ map_arg_registers (objc, objv, func, 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.  */
+     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.  */
 
   if (objc == 0)               /* No args, just do all the regs */
     {
       for (regnum = 0;
            regnum < NUM_REGS
-             && reg_names[regnum] != NULL
-             && *reg_names[regnum] != '\000';
+             && REGISTER_NAME (regnum) != NULL
+             && *REGISTER_NAME (regnum) != '\000';
            regnum++)
         func (regnum, argp);
 
@@ -1530,8 +1571,8 @@ map_arg_registers (objc, objv, func, argp)
 
       if (regnum >= 0
           && regnum < NUM_REGS
-          && reg_names[regnum] != NULL
-          && *reg_names[regnum] != '\000')
+          && REGISTER_NAME (regnum) != NULL
+          && *REGISTER_NAME (regnum) != '\000')
         func (regnum, argp);
       else
         {
@@ -1565,7 +1606,7 @@ get_register_name (regnum, argp)
      void *argp;               /* Ignored */
 {
   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                            Tcl_NewStringObj (reg_names[regnum], -1));
+                            Tcl_NewStringObj (REGISTER_NAME (regnum), -1));
 }
 
 /* This implements the tcl command gdb_fetch_registers
@@ -1614,11 +1655,18 @@ get_register (regnum, fp)
   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;
 
-  if (read_relative_register_raw_bytes (regnum, raw_buffer))
+  /* 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));
@@ -1647,7 +1695,7 @@ get_register (regnum, fp)
         }
     }
   else
-    val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
+    val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, 0,
                gdb_stdout, format, 1, 0, Val_pretty_default);
 
 }
@@ -1818,7 +1866,7 @@ gdb_get_tracepoint_info (clientData, interp, objc, objv)
   struct tracepoint *tp;
   struct action_line *al;
   Tcl_Obj *action_list;
-  char *filename, *funcname;
+  char *filename, *funcname, *fname;
   char tmp[19];
   
   if (objc != 2)
@@ -1839,7 +1887,9 @@ gdb_get_tracepoint_info (clientData, interp, objc, objv)
 
   if (tp == NULL)
     {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Tracepoint #%d does not exist", -1);
+      char buff[64];
+      sprintf (buff, "Tracepoint #%d does not exist", tpnum);
+      Tcl_SetStringObj (result_ptr->obj_ptr, buff, -1);
       return TCL_ERROR;
     }
 
@@ -1850,8 +1900,19 @@ gdb_get_tracepoint_info (clientData, interp, objc, objv)
     filename = "N/A";
   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
                             Tcl_NewStringObj (filename, -1));
+  
   find_pc_partial_function (tp->address, &funcname, NULL, NULL);
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (funcname, -1));
+  fname = cplus_demangle (funcname, 0);
+  if (fname)
+    {
+      Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj
+                         (fname, -1));
+      free (fname);
+    }
+  else
+    Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj
+                             (funcname, -1));
+  
   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (sal.line));
   sprintf (tmp, "0x%lx", tp->address);
   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (tmp, -1));
@@ -2035,7 +2096,7 @@ gdb_disassemble (clientData, interp, objc, objv)
       di_initialized = 1;
     }
 
-  di.mach = tm_print_insn_info.mach;
+  di.mach = TARGET_PRINT_INSN_INFO->mach;
   if (TARGET_BYTE_ORDER == BIG_ENDIAN)
     di.endian = BFD_ENDIAN_BIG;
   else
@@ -2686,7 +2747,7 @@ gdb_loadfile (clientData, interp, objc, objv)
               cur_cmd = &text_cmd_1;
               cur_prefix_len = prefix_len_1;
               Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
-              Tcl_DStringAppend (cur_cmd, "} break_tag", 11);
+              Tcl_DStringAppend (cur_cmd, "} break_rgn_tag", 15);
             }
           else
             {
@@ -2706,7 +2767,7 @@ gdb_loadfile (clientData, interp, objc, objv)
     }
   else
     {
-      Tcl_DStringAppend (&text_cmd_1, " insert end {- } break_tag", -1);
+      Tcl_DStringAppend (&text_cmd_1, " insert end {- } break_rgn_tag", -1);
       prefix_len_1 = Tcl_DStringLength(&text_cmd_1);
       Tcl_DStringAppend (&text_cmd_2, " insert end {  } \"\"", -1);
       prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
@@ -2851,6 +2912,106 @@ gdb_set_bp (clientData, interp, objc, objv)
   Tcl_DStringAppendElement (&cmd, buf);
   Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[2], NULL));
   Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[1], NULL));
+  Tcl_DStringAppendElement (&cmd, bpdisp[b->disposition]);
+  sprintf (buf, "%d", b->enable);
+  Tcl_DStringAppendElement (&cmd, buf);
+  sprintf (buf, "%d", b->thread);
+  Tcl_DStringAppendElement (&cmd, buf);
+  
+
+  ret = Tcl_Eval (interp, Tcl_DStringValue (&cmd));
+  Tcl_DStringFree (&cmd);
+  return ret;
+}
+
+/* This implements the tcl command "gdb_set_bp_addr"
+ * It sets breakpoints, and runs the Tcl command
+ *     gdbtk_tcl_breakpoint create
+ * to register the new breakpoint with the GUI.
+ *
+ * Tcl Arguments:
+ *    addr: the address at which to set the breakpoint
+ *    type:     the type of the breakpoint
+ *    thread:  optional thread number
+ * Tcl Result:
+ *    The return value of the call to gdbtk_tcl_breakpoint.
+ */
+
+static int
+gdb_set_bp_addr (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+
+{
+  struct symtab_and_line sal;
+  int line, flags, ret, thread = -1;
+  long addr;
+  struct breakpoint *b;
+  char *filename, buf[64];
+  Tcl_DString cmd;
+
+  if (objc != 4 && objc != 3)
+    {
+      Tcl_WrongNumArgs(interp, 1, objv, "addr type ?thread?");
+      return TCL_ERROR; 
+    }
+  
+  if (Tcl_GetLongFromObj( interp, objv[1], &addr) == TCL_ERROR)
+    {
+      result_ptr->flags = GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+
+  if (Tcl_GetIntFromObj( interp, objv[2], &flags) == TCL_ERROR)
+    {
+      result_ptr->flags = GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+
+  if (objc == 4)
+    {
+      if (Tcl_GetIntFromObj( interp, objv[3], &thread) == TCL_ERROR)
+       {
+         result_ptr->flags = GDBTK_IN_TCL_RESULT;
+         return TCL_ERROR;
+       }
+    }
+
+  sal = find_pc_line (addr, 0);
+  sal.pc = addr;
+  b = set_raw_breakpoint (sal);
+  set_breakpoint_count (breakpoint_count + 1);
+  b->number = breakpoint_count;
+  b->type = flags >> 2;
+  b->disposition = flags & 3;
+  b->thread = thread;
+
+  sprintf (buf, "*(0x%lx)",addr);
+  b->addr_string = strsave (buf);
+
+  /* now send notification command back to GUI */
+
+  Tcl_DStringInit (&cmd);
+
+  Tcl_DStringAppend (&cmd, "gdbtk_tcl_breakpoint create ", -1);
+  sprintf (buf, "%d", b->number);
+  Tcl_DStringAppendElement(&cmd, buf);
+  sprintf (buf, "0x%lx", addr);
+  Tcl_DStringAppendElement (&cmd, buf);
+  sprintf (buf, "%d", b->line_number);
+  Tcl_DStringAppendElement (&cmd, buf);
+
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "";
+  Tcl_DStringAppendElement (&cmd, filename);
+  Tcl_DStringAppendElement (&cmd, bpdisp[b->disposition]);
+  sprintf (buf, "%d", b->enable);
+  Tcl_DStringAppendElement (&cmd, buf);
+  sprintf (buf, "%d", b->thread);
+  Tcl_DStringAppendElement (&cmd, buf);
 
   ret = Tcl_Eval (interp, Tcl_DStringValue (&cmd));
   Tcl_DStringFree (&cmd);
@@ -2964,13 +3125,6 @@ gdb_get_breakpoint_info (clientData, interp, objc, objv)
      Tcl_Obj *CONST objv[];
 {
   struct symtab_and_line sal;
-  static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
-                             "finish", "watchpoint", "hardware watchpoint",
-                             "read watchpoint", "access watchpoint",
-                             "longjmp", "longjmp resume", "step resume",
-                             "through sigtramp", "watchpoint scope",
-                             "call dummy" };
-  static char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
   struct command_line *cmd;
   int bpnum;
   struct breakpoint *b;
@@ -2996,7 +3150,9 @@ gdb_get_breakpoint_info (clientData, interp, objc, objv)
 
   if (!b || b->type != bp_breakpoint)
     {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Breakpoint #%d does not exist", -1);
+      char err_buf[64];
+      sprintf(err_buf, "Breakpoint #%d does not exist.", bpnum);
+      Tcl_SetStringObj (result_ptr->obj_ptr, err_buf, -1);
       return TCL_ERROR;
     }
 
@@ -3239,7 +3395,7 @@ get_frame_name (interp, list, fi)
           print_address_numeric (fi->pc, 1, gdb_stdout);
           printf_filtered (" in ");
         }
-      printf_symbol_filtered (gdb_stdout, funname ? funname : "??", funlang,
+      fprintf_symbol_filtered (gdb_stdout, funname ? funname : "??", funlang,
                                DMGL_ANSI);
 #endif
       objv[0] = Tcl_NewStringObj (funname != NULL ? funname : "??", -1);
@@ -3293,11 +3449,11 @@ gdb_path_conv (clientData, interp, objc, objv)
   if (objc != 2)
     error ("wrong # args");
   
-#ifdef WINNT
+#ifdef __CYGWIN__
   {
     char pathname[256], *ptr;
 
-    cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj(objv[1], NULL), pathname);
+    cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj (objv[1], NULL), pathname);
     for (ptr = pathname; *ptr; ptr++)
       {
        if (*ptr == '\\')
This page took 0.02855 seconds and 4 git commands to generate.