diff options
Diffstat (limited to 'gdb/gdbtk-variable.c')
| -rw-r--r-- | gdb/gdbtk-variable.c | 1629 |
1 files changed, 0 insertions, 1629 deletions
diff --git a/gdb/gdbtk-variable.c b/gdb/gdbtk-variable.c deleted file mode 100644 index f1e7455..0000000 --- a/gdb/gdbtk-variable.c +++ /dev/null @@ -1,1629 +0,0 @@ -/* Variable user interface for GDB, the GNU debugger. - Copyright 1999 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 "value.h" -#include "expression.h" -#include "frame.h" -#include "valprint.h" - -#include <tcl.h> -#include <tk.h> -#include "gdbtk.h" -#include "gdbtk-wrapper.h" - -#include <math.h> - -/* Enumeration type defining the return values for valueChanged */ -enum value_changed -{ - VALUE_UNCHANGED, /* the variable's value is unchanged */ - VALUE_CHANGED, /* the variable's value has changed */ - VALUE_OUT_OF_SCOPE /* the variable is no longer in scope */ -}; - -/* String representations of the value_changed enums */ -static char *value_changed_string[] = { - "VARIABLE_UNCHANGED", - "VARIABLE_CHANGED", - "VARIABLE_OUT_OF_SCOPE", - NULL -}; - -/* Enumeration for the format types */ -enum display_format -{ - FORMAT_NATURAL, /* What gdb actually calls 'natural' */ - FORMAT_BINARY, /* Binary display */ - FORMAT_DECIMAL, /* Decimal display */ - FORMAT_HEXADECIMAL, /* Hex display */ - FORMAT_OCTAL /* Octal display */ -}; - -/* Mappings of display_format enums to gdb's format codes */ -int format_code[] = {0, 't', 'd', 'x', 'o'}; - -/* String representations of the format codes */ -char *format_string[] = {"natural", "binary", "decimal", "hexadecimal", "octal"}; - -/* Every parent variable keeps a linked list of its children, described - by the following structure. */ -struct variable_child { - - /* Pointer to the child's data */ - struct _gdb_variable *child; - - /* Pointer to the next child */ - struct variable_child *next; -}; - -/* Every variable in the system has a structure of this type defined - for it. This structure holds all information necessary to manipulate - a particular object variable. Members which must be freed are noted. */ -struct _gdb_variable { - - /* Alloc'd name of the variable for this object.. If this variable is a - child, then this name will be the child's source name. - (bar, not foo.bar) */ - char *name; - - /* The alloc'd real name of this variable. This is used to construct the - variable's children. It is always a valid expression. */ - char *real_name; - - /* The alloc'd name for this variable's object. This is here for - convenience when constructing this object's children. */ - char *obj_name; - - /* Alloc'd expression for this variable */ - struct expression *exp; - - /* Block for which this expression is valid */ - struct block *valid_block; - - /* The frame for this expression */ - CORE_ADDR frame; - - /* The value of this expression */ - value_ptr value; - - /* Did an error occur evaluating the expression or getting its value? */ - int error; - - /* The number of (immediate) children this variable has */ - int num_children; - - /* If this object is a child, this points to its parent. */ - struct _gdb_variable *parent; - - /* A list of this object's children */ - struct variable_child *children; - - /* The format of the output for this object */ - enum display_format format; -}; - -typedef struct _gdb_variable gdb_variable; - -/* This variable will hold the value of the output from gdb - for commands executed through call_gdb_* */ -static Tcl_Obj *fputs_obj; - -/* - * Public functions defined in this file - */ - -int gdb_variable_init PARAMS ((Tcl_Interp *)); - -/* - * Private functions defined in this file - */ - -/* Entries into this file */ - -static int gdb_variable_command PARAMS ((ClientData, Tcl_Interp *, int, - Tcl_Obj *CONST[])); - -static int variable_create PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[])); - -static void variable_delete PARAMS ((Tcl_Interp *, gdb_variable *)); - -static void variable_debug PARAMS ((gdb_variable *)); - -static int variable_obj_command PARAMS ((ClientData, Tcl_Interp *, int, - Tcl_Obj *CONST[])); -static Tcl_Obj *variable_children PARAMS ((Tcl_Interp *, gdb_variable *)); - -static enum value_changed variable_value_changed PARAMS ((gdb_variable *)); - -static int variable_format PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[], - gdb_variable *)); - -static int variable_type PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[], - gdb_variable *)); - -static int variable_value PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[], - gdb_variable *)); - -static int variable_editable PARAMS ((gdb_variable *)); - -/* Helper functions for the above functions. */ - -static gdb_variable *create_variable PARAMS ((char *, char *, CORE_ADDR)); - -static void delete_children PARAMS ((Tcl_Interp *, gdb_variable *, int)); - -static void install_variable PARAMS ((Tcl_Interp *, char *, gdb_variable *)); - -static void uninstall_variable PARAMS ((Tcl_Interp *, gdb_variable *)); - -static gdb_variable *child_exists PARAMS ((gdb_variable *, char *)); - -static gdb_variable *create_child PARAMS ((Tcl_Interp *, gdb_variable *, - char *, int)); -static char *name_of_child PARAMS ((gdb_variable *, int)); - -static int number_of_children PARAMS ((gdb_variable *)); - -static enum display_format variable_default_display PARAMS ((gdb_variable *)); - -static void save_child_in_parent PARAMS ((gdb_variable *, gdb_variable *)); - -static void remove_child_from_parent PARAMS ((gdb_variable *, gdb_variable *)); - -static struct type *get_type PARAMS ((value_ptr)); - -static struct type *get_target_type PARAMS ((struct type *)); - -static Tcl_Obj *get_call_output PARAMS ((void)); - -static void clear_gdb_output PARAMS ((void)); - -static int call_gdb_type_print PARAMS ((value_ptr)); - -static int call_gdb_val_print PARAMS ((value_ptr, int)); - -static void variable_fputs PARAMS ((const char *, GDB_FILE *)); - -static void null_fputs PARAMS ((const char *, GDB_FILE *)); - -static int my_value_equal PARAMS ((gdb_variable *, value_ptr)); - -#define INIT_VARIABLE(x) { \ -(x)->name = NULL; \ -(x)->real_name = NULL; \ -(x)->obj_name = NULL; \ -(x)->exp = NULL; \ -(x)->valid_block = NULL; \ -(x)->frame = (CORE_ADDR) 0; \ -(x)->value = NULL; \ -(x)->error = 0; \ -(x)->num_children = 0; \ -(x)->parent = NULL; \ -(x)->children = NULL; \ -(x)->format = FORMAT_NATURAL; \ -} - -#if defined(FREEIF) -# undef FREEIF -#endif -#define FREEIF(x) if (x != NULL) free((char *) (x)) - -/* Initialize the variable code. This function should be called once - to install and initialize the variable code into the interpreter. */ -int -gdb_variable_init (interp) - Tcl_Interp *interp; -{ - Tcl_Command result; - - result = Tcl_CreateObjCommand (interp, "gdb_variable", call_wrapper, - (ClientData) gdb_variable_command, NULL); - if (result == NULL) - return TCL_ERROR; - - return TCL_OK; -} - -/* This function defines the "gdb_variable" command which is used to - create variable objects. Its syntax includes: - - gdb_variable create - gdb_variable create NAME - gdb_variable create -expr EXPR - gdb_variable create NAME -expr EXPR - - NAME = name of object to create. If no NAME, then automatically create - a name - EXPR = the gdb expression for which to create a variable. This will - be the most common usage. -*/ -static int -gdb_variable_command (clientData, interp, objc, objv) - ClientData clientData; - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ - static char *commands[] = { "create", NULL }; - enum commands_enum { VARIABLE_CREATE }; - int index, result; - - if (objc < 2) - { - Tcl_WrongNumArgs (interp, 1, objv, "option ?arg...?"); - return TCL_ERROR; - } - - if (Tcl_GetIndexFromObj (interp, objv[1], commands, "options", 0, - &index) != TCL_OK) - { - return TCL_ERROR; - } - - switch ((enum commands_enum) index) - { - case VARIABLE_CREATE: - result = variable_create (interp, objc - 2, objv + 2); - break; - - default: - return TCL_ERROR; - } - - return result; -} - -/* This function implements the actual object command for each - variable object that is created (and each of its children). - - Currently the following commands are implemented: - - delete delete this object and its children - - valueChanged has the value of this object changed since the last check? - - numChildren how many children does this object have - - children create the children and return a list of their objects - - debug print out a little debug info for the object - - name print out the name of this variable -*/ -static int -variable_obj_command (clientData, interp, objc, objv) - ClientData clientData; - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ - enum commands_enum { - VARIABLE_DELETE, - VARIABLE_VALUE_CHANGED, - VARIABLE_NUM_CHILDREN, - VARIABLE_CHILDREN, - VARIABLE_DEBUG, - VARIABLE_FORMAT, - VARIABLE_TYPE, - VARIABLE_VALUE, - VARIABLE_NAME, - VARIABLE_EDITABLE - }; - static char *commands[] = { - "delete", - "valueChanged", - "numChildren", - "children", - "debug", - "format", - "type", - "value", - "name", - "editable", - NULL - }; - gdb_variable *var = (gdb_variable *) clientData; - int index, result; - - if (objc < 2) - { - Tcl_WrongNumArgs (interp, 1, objv, "option ?arg...?"); - return TCL_ERROR; - } - - if (Tcl_GetIndexFromObj (interp, objv[1], commands, "options", 0, - &index) != TCL_OK) - return TCL_ERROR; - - result = TCL_OK; - switch ((enum commands_enum) index) - { - case VARIABLE_DELETE: - if (objc > 2) - { - int len; - char *s = Tcl_GetStringFromObj (objv[2], &len); - if (*s == 'c' && strncmp (s, "children", len) == 0) - { - delete_children (interp, var, 1); - break; - } - } - variable_delete (interp, var); - break; - - case VARIABLE_VALUE_CHANGED: - { - enum value_changed vc = variable_value_changed (var); - Tcl_SetObjResult (interp, Tcl_NewStringObj (value_changed_string[vc], -1)); - } - break; - - case VARIABLE_NUM_CHILDREN: - Tcl_SetObjResult (interp, Tcl_NewIntObj (var->num_children)); - break; - - case VARIABLE_CHILDREN: - { - Tcl_Obj *children = variable_children (interp, var); - Tcl_SetObjResult (interp, children); - } - break; - - case VARIABLE_DEBUG: - variable_debug (var); - break; - - case VARIABLE_FORMAT: - result = variable_format (interp, objc, objv, var); - break; - - case VARIABLE_TYPE: - result = variable_type (interp, objc, objv, var); - break; - - case VARIABLE_VALUE: - result = variable_value (interp, objc, objv, var); - break; - - case VARIABLE_NAME: - Tcl_SetObjResult (interp, Tcl_NewStringObj (var->name, -1)); - break; - - case VARIABLE_EDITABLE: - Tcl_SetObjResult (interp, Tcl_NewIntObj (variable_editable (var))); - break; - - default: - return TCL_ERROR; - } - - return result; -} - -/* - * Variable object construction/destruction - */ - -/* This function is responsible for processing the user's specifications - and constructing a variable object. */ -static int -variable_create (interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; -{ - enum create_opts { CREATE_EXPR, CREATE_PC }; - static char *create_options[] = { "-expr", "-pc", NULL }; - gdb_variable *var; - char *name; - char obj_name[31]; - int index; - static int id = 0; - CORE_ADDR pc = (CORE_ADDR) -1; - - /* REMINDER: This command may be invoked in the following ways: - gdb_variable create - gdb_variable create NAME - gdb_variable create -expr EXPR - gdb_variable create NAME -expr EXPR - - NAME = name of object to create. If no NAME, then automatically create - a name - EXPR = the gdb expression for which to create a variable. This will - be the most common usage. - */ - name = NULL; - if (objc) - name = Tcl_GetStringFromObj (objv[0], NULL); - if (name == NULL || *name == '-') - { - /* generate a name for this object */ - id++; - sprintf (obj_name, "var%d", id); - } - else - { - /* specified name for object */ - strncpy (obj_name, name, 30); - objv++; - objc--; - } - - /* Run through all the possible options for this command */ - name = NULL; - while (objc > 0) - { - if (Tcl_GetIndexFromObj (interp, objv[0], create_options, "options", - 0, &index) != TCL_OK) - { - result_ptr->flags |= GDBTK_IN_TCL_RESULT; - return TCL_ERROR; - } - - switch ((enum create_opts) index) - { - case CREATE_EXPR: - name = Tcl_GetStringFromObj (objv[1], NULL); - objc--; - objv++; - break; - - case CREATE_PC: - { - char *str; - str = Tcl_GetStringFromObj (objv[1], NULL); - pc = parse_and_eval_address (str); - objc--; - objv++; - } - break; - - default: - break; - } - - objc--; - objv++; - } - - /* Create the variable */ - { - /* Add parentheses to the name so that casts do - not confuse it. */ - char *newname = (char *) xmalloc (strlen (name) + 3); - sprintf (newname, "(%s)", name); - var = create_variable (name, newname, pc); - FREEIF (newname); - } - - if (var != NULL) - { - /* Install a command into the interpreter that represents this - object */ - install_variable (interp, obj_name, var); - Tcl_SetObjResult (interp, Tcl_NewStringObj (obj_name, -1)); - result_ptr->flags |= GDBTK_IN_TCL_RESULT; - - return TCL_OK; - } - - return TCL_ERROR; -} - -/* Fill out a gdb_variable structure for the variable being constructed. - This function should never fail if real_name is a valid expression. - (That means no longjmp'ing!) */ -static gdb_variable * -create_variable (name, real_name, pc) - char *name; - char *real_name; - CORE_ADDR pc; -{ - gdb_variable *var; - value_ptr mark; - struct frame_info *fi, *old_fi; - struct block *block; - void (*old_fputs) PARAMS ((const char *, GDB_FILE *)); - gdb_result r; - - var = (gdb_variable *) xmalloc (sizeof (gdb_variable)); - INIT_VARIABLE (var); - - if (name != NULL) - { - char *p; - - /* Parse and evaluate the expression, filling in as much - of the variable's data as possible */ - - /* Allow creator to specify context of variable */ - if (pc == (CORE_ADDR) -1) - block = 0; - else - { - r = GDB_block_for_pc (pc, &block); - if (r != GDB_OK) - block = 0; - } - - p = real_name; - innermost_block = NULL; - r = GDB_parse_exp_1 (&p, block, 0, &(var->exp)); - if (r != GDB_OK) - { - FREEIF ((char *) var); - return NULL; - } - - /* Don't allow variables to be created for types. */ - if (var->exp->elts[0].opcode == OP_TYPE) - { - free_current_contents ((char **) &(var->exp)); - FREEIF (var); - printf_unfiltered ("Attempt to use a type name as an expression."); - return NULL; - } - - var->valid_block = innermost_block; - var->name = savestring (name, strlen (name)); - var->real_name = savestring (real_name, strlen (real_name)); - - /* Several of the GDB_* calls can cause messages to be displayed. We swallow - those here, because we don't need them (the "value" command will - show them). */ - old_fputs = fputs_unfiltered_hook; - fputs_unfiltered_hook = null_fputs; - - /* When the PC is different from the current PC (pc == -1), - then we must select the appropriate frame before parsing - the expression, otherwise the value will not be current. - Since select_frame is so benign, just call it for all cases. */ - r = GDB_block_innermost_frame (var->valid_block, &fi); - if (r != GDB_OK) - fi = NULL; - if (fi) - var->frame = FRAME_FP (fi); - old_fi = selected_frame; - GDB_select_frame (fi, -1); - - mark = value_mark (); - if (GDB_evaluate_expression (var->exp, &var->value) == GDB_OK) - { - release_value (var->value); - if (VALUE_LAZY (var->value)) - { - if (GDB_value_fetch_lazy (var->value) != GDB_OK) - var->error = 1; - else - var->error = 0; - } - } - else - var->error = 1; - value_free_to_mark (mark); - - /* Reset the selected frame */ - GDB_select_frame (old_fi, -1); - - /* Restore the output hook to normal */ - fputs_unfiltered_hook = old_fputs; - - var->num_children = number_of_children (var); - var->format = variable_default_display (var); - } - - return var; -} - -/* Install the given variable VAR into the tcl interpreter with - the object name NAME. */ -static void -install_variable (interp, name, var) - Tcl_Interp *interp; - char *name; - gdb_variable *var; -{ - var->obj_name = savestring (name, strlen (name)); - Tcl_CreateObjCommand (interp, name, variable_obj_command, - (ClientData) var, NULL); -} - -/* Unistall the object VAR in the tcl interpreter. */ -static void -uninstall_variable (interp, var) - Tcl_Interp *interp; - gdb_variable *var; -{ - Tcl_DeleteCommand (interp, var->obj_name); -} - -/* Delete the variable object VAR and its children */ -static void -variable_delete (interp, var) - Tcl_Interp *interp; - gdb_variable *var; -{ - /* Delete any children of this variable, too. */ - delete_children (interp, var, 0); - - /* If this variable has a parent, remove it from its parent's list */ - if (var->parent != NULL) - { - remove_child_from_parent (var->parent, var); - } - - uninstall_variable (interp, var); - - /* Free memory associated with this variable */ - FREEIF (var->name); - FREEIF (var->real_name); - FREEIF (var->obj_name); - if (var->exp != NULL) - free_current_contents ((char **) &var->exp); - FREEIF (var); -} - -/* Silly debugging info */ -static void -variable_debug (var) - gdb_variable *var; -{ - Tcl_Obj *str; - - str = Tcl_NewStringObj ("name=", -1); - Tcl_AppendStringsToObj (str, var->name, "\nreal_name=", var->real_name, - "\nobj_name=", var->obj_name, NULL); - Tcl_SetObjResult (gdbtk_interp, str); -} - -/* - * Child construction/destruction - */ - -/* Delete the children associated with the object VAR. If NOTIFY is set, - notify the parent object that this child was deleted. This is used as - a small optimization when deleting variables and their children. If the - parent is also being deleted, don't bother notifying it that its children - are being deleted. */ -static void -delete_children (interp, var, notify) - Tcl_Interp *interp; - gdb_variable *var; - int notify; -{ - struct variable_child *vc; - struct variable_child *next; - - for (vc = var->children; vc != NULL; vc = next) - { - if (!notify) - vc->child->parent = NULL; - variable_delete (interp, vc->child); - next = vc->next; - free (vc); - } -} - -/* Return the number of children for a given variable. - - This can get a little complicated, since we would like to make - certain assumptions about certain types of variables. - - - struct/union *: dereference first - - (*)(): do not allow derefencing - - arrays: - - declared size = num of children or - - -1 if we don't know, i.e., int foo []; - - if there was an error reported constructing this object, - assume it has no children (and try this again later) - - void * and char * have no children -*/ -static int -number_of_children (var) - gdb_variable *var; -{ - struct type *type; - struct type *target; - int children; - - if (var->value != NULL) - { - type = get_type (var->value); - target = get_target_type (type); - children = 0; - - switch (TYPE_CODE (type)) - { - case TYPE_CODE_ARRAY: - if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (target) > 0 - && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) - children = TYPE_LENGTH (type) / TYPE_LENGTH (target); - else - children = -1; - break; - - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - /* If we have a virtual table pointer, omit it. */ - if (TYPE_VPTR_BASETYPE (type) == type - && !(TYPE_VPTR_FIELDNO (type) < 0)) - children = TYPE_NFIELDS (type) - 1; - else - children = TYPE_NFIELDS (type); - break; - - case TYPE_CODE_PTR: - /* This is where things get compilcated. All pointers have one child. - Except, of course, for struct and union ptr, which we automagically - dereference for the user and function ptrs, which have no children. */ - switch (TYPE_CODE (target)) - { - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - /* If we have a virtual table pointer, omit it. */ - if (TYPE_VPTR_BASETYPE (target) == target - && !(TYPE_VPTR_FIELDNO (target) < 0)) - children = TYPE_NFIELDS (target) - 1; - else - children = TYPE_NFIELDS (target); - break; - - case TYPE_CODE_FUNC: - children = 0; - break; - - default: - /* Don't dereference char* or void*. */ - if (TYPE_NAME (target) != NULL - && (STREQ (TYPE_NAME (target), "char") - || STREQ (TYPE_NAME (target), "void"))) - children = 0; - else - children = 1; - } - break; - - default: - break; - } - } - else - { - /* var->value can be null if we tried to access non-existent or - protected memory. In this case, we simply do not allow any - children. This will be checked again when we check if its - value has changed. */ - children = 0; - } - - return children; -} - -/* Return a list of all the children of VAR, creating them if necessary. */ -static Tcl_Obj * -variable_children (interp, var) - Tcl_Interp *interp; - gdb_variable *var; -{ - Tcl_Obj *list; - gdb_variable *child; - char *name; - int i; - - list = Tcl_NewListObj (0, NULL); - for (i = 0; i < var->num_children; i++) - { - /* check if child exists */ - name = name_of_child (var, i); - child = child_exists (var, name); - if (child == NULL) - { - child = create_child (interp, var, name, i); - - /* name_of_child returns a malloc'd string */ - free (name); - } - Tcl_ListObjAppendElement (NULL, list, Tcl_NewStringObj (child->obj_name, -1)); - } - - return list; -} - -/* Does a child with the name NAME exist in VAR? If so, return its data. - If not, return NULL. */ -static gdb_variable * -child_exists (var, name) - gdb_variable *var; /* Parent */ - char *name; /* name of child */ -{ - struct variable_child *vc; - - for (vc = var->children; vc != NULL; vc = vc->next) - { - if (STREQ (vc->child->name, name)) - return vc->child; - } - - return NULL; -} - -/* Create and install a child of the parent of the given name */ -static gdb_variable * -create_child (interp, parent, name, index) - Tcl_Interp *interp; - gdb_variable *parent; - char *name; - int index; -{ - struct type *type; - struct type *target; - gdb_variable *child; - char separator[10], prefix[2048], suffix[20]; - char *childs_name; - char *save_name; - int deref = 0; - int len; - - /* name should never be null. For pointer derefs, it should contain "*name". - For arrays of a known size, the name will simply contain the index into - the array. */ - - separator[0] = '\0'; - prefix[0] = '\0'; - suffix[0] = '\0';; - save_name = name; - - /* This code must contain a lot of the logic for children based on the parent's - type. */ - type = get_type (parent->value); - target = get_target_type (type); - - switch (TYPE_CODE (type)) - { - case TYPE_CODE_ARRAY: - sprintf (suffix, "[%s]", name); - name = ""; - break; - - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - if (index < TYPE_N_BASECLASSES (type)) - { - strcpy (prefix, "(("); - strcat (prefix, name); - strcat (prefix, ")"); - strcpy (suffix, ") "); - name = ""; - } - else - strcpy (separator, "."); - break; - - case TYPE_CODE_PTR: - switch (TYPE_CODE (target)) - { - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - if (index < TYPE_N_BASECLASSES (target)) - { - strcpy (prefix, "(*("); - strcat (prefix, name); - strcat (prefix, " *)"); - strcpy (suffix, ")"); - name = ""; - } - else - strcpy (separator, "->"); - break; - - default: - deref = 1; - break; - } - - default: - break; - } - - /* When we get here, we should know how to construct a legal - expression for the child's name */ - len = strlen (prefix); - len += strlen (parent->real_name); - len += strlen (separator); - len += strlen (name); - len += strlen (suffix); - if (deref) - len += 3; - childs_name = (char *) xmalloc ((len + 1) * sizeof (char)); - if (deref) - { - strcpy (childs_name, "(*"); - strcat (childs_name, parent->real_name); - strcat (childs_name, suffix); - strcat (childs_name, ")"); - } - else - { - strcpy (childs_name, prefix); - strcat (childs_name, parent->real_name); - strcat (childs_name, separator); - strcat (childs_name, name); - strcat (childs_name, suffix); - } - - /* childs_name now contains a valid expression for the child */ - child = create_variable (save_name, childs_name, (CORE_ADDR) -1); - child->parent = parent; - free (childs_name); - childs_name = (char *) xmalloc ((strlen (parent->obj_name) + strlen (save_name) + 2) - * sizeof (char)); - sprintf (childs_name, "%s.%s", parent->obj_name, save_name); - install_variable (interp, childs_name, child); - free (childs_name); - - /* Save a pointer to this child in the parent */ - save_child_in_parent (parent, child); - - return child; -} - -/* Save CHILD in the PARENT's data. */ -static void -save_child_in_parent (parent, child) - gdb_variable *parent; - gdb_variable *child; -{ - struct variable_child *vc; - - /* Insert the child at the top */ - vc = parent->children; - parent->children = - (struct variable_child *) xmalloc (sizeof (struct variable_child)); - - parent->children->next = vc; - parent->children->child = child; -} - -/* Remove the CHILD from the PARENT's list of children. */ -static void -remove_child_from_parent (parent, child) - gdb_variable *parent; - gdb_variable *child; -{ - struct variable_child *vc, *prev; - - /* Find the child in the parent's list */ - prev = NULL; - for (vc = parent->children; vc != NULL; ) - { - if (vc->child == child) - break; - prev = vc; - vc = vc->next; - } - - if (prev == NULL) - parent->children = vc->next; - else - prev->next = vc->next; - -} - -/* What is the name of the INDEX'th child of VAR? */ -static char * -name_of_child (var, index) - gdb_variable *var; - int index; -{ - struct type *type; - struct type *target; - char *name; - char *string; - - type = get_type (var->value); - target = get_target_type (type); - - switch (TYPE_CODE (type)) - { - case TYPE_CODE_ARRAY: - { - /* We never get here unless var->num_children is greater than 0... */ - int len = 1; - while ((int) pow ((double) 10, (double) len) < index) - len++; - name = (char *) xmalloc (1 + len * sizeof (char)); - sprintf (name, "%d", index); - } - break; - - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - string = TYPE_FIELD_NAME (type, index); - name = savestring (string, strlen (string)); - break; - - case TYPE_CODE_PTR: - switch (TYPE_CODE (target)) - { - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - string = TYPE_FIELD_NAME (target, index); - name = savestring (string, strlen (string)); - break; - - default: - name = (char *) xmalloc ((strlen (var->name) + 2) * sizeof (char)); - sprintf (name, "*%s", var->name); - break; - } - } - - return name; -} - -/* Has the value of this object changed since the last time we looked? - - There are some special cases: - - structs/unions/arrays. The "value" of these never changes. - Only their children's values change. - - if an error occurred with evaluate_expression or fetch_value_lazy, - then we need to be a little more elaborate with our determination - of "value changed". Specifically, the value does not change when - both the previous evaluate fails and the one done here also fails. -*/ -static enum value_changed -variable_value_changed (var) - gdb_variable *var; -{ - value_ptr mark, new_val; - struct frame_info *fi, *old_fi; - int within_scope; - enum value_changed result; - gdb_result r; - - /* Save the selected stack frame, since we will need to change it - in order to evaluate expressions. */ - old_fi = selected_frame; - - /* Determine whether the variable is still around. */ - if (var->valid_block == NULL) - within_scope = 1; - else - { - GDB_reinit_frame_cache (); - r = GDB_find_frame_addr_in_frame_chain (var->frame, &fi); - if (r != GDB_OK) - fi = NULL; - within_scope = fi != NULL; - /* FIXME: GDB_select_frame could fail */ - if (within_scope) - GDB_select_frame (fi, -1); - } - - result = VALUE_OUT_OF_SCOPE; - if (within_scope) - { - struct type *type = get_type (var->value); - - /* Arrays, struct, classes, unions never change value */ - if (type != NULL && (TYPE_CODE (type) == TYPE_CODE_STRUCT - || TYPE_CODE (type) == TYPE_CODE_UNION - || TYPE_CODE (type) == TYPE_CODE_ARRAY)) - result = VALUE_UNCHANGED; - else - { - mark = value_mark (); - if (GDB_evaluate_expression (var->exp, &new_val) == GDB_OK) - { - if (!my_value_equal (var, new_val)) - { - /* value changed */ - release_value (new_val); - if (var->value == NULL) - { - /* This can happen if there was an error - evaluating the expression (like deref NULL) */ - var->num_children = number_of_children (var); - } - value_free (var->value); - var->value = new_val; - result = VALUE_CHANGED; - } - else - result = VALUE_UNCHANGED; - } - else - { - /* evaluate expression failed. If we failed before, then - the value of this variable has not changed. If we - succeed before, then the value did change. */ - if (var->value == NULL) - result = VALUE_UNCHANGED; - else - { - var->value = NULL; - var->error = 1; - result = VALUE_CHANGED; - } - } - - value_free_to_mark (mark); - } - } - - /* Restore selected frame */ - GDB_select_frame (old_fi, -1); - - return result; -} - -static int -variable_format (interp, objc, objv, var) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; - gdb_variable *var; -{ - - if (objc > 2) - { - /* Set the format of VAR to given format */ - int len; - char *fmt = Tcl_GetStringFromObj (objv[2], &len); - if (STREQN (fmt, "natural", len)) - var->format = FORMAT_NATURAL; - else if (STREQN (fmt, "binary", len)) - var->format = FORMAT_BINARY; - else if (STREQN (fmt, "decimal", len)) - var->format = FORMAT_DECIMAL; - else if (STREQN (fmt, "hexadecimal", len)) - var->format = FORMAT_HEXADECIMAL; - else if (STREQN (fmt, "octal", len)) - var->format = FORMAT_OCTAL; - else - { - Tcl_Obj *obj = Tcl_NewStringObj (NULL, 0); - Tcl_AppendStringsToObj (obj, "unknown display format \"", - fmt, "\": must be: \"natural\", \"binary\"" - ", \"decimal\", \"hexadecimal\", or \"octal\"", - NULL); - Tcl_SetObjResult (interp, obj); - return TCL_ERROR; - } - } - else - { - /* Report the current format */ - Tcl_Obj *fmt; - - fmt = Tcl_NewStringObj (format_string [(int) var->format], -1); - Tcl_SetObjResult (interp, fmt); - } - - return TCL_OK; -} - -/* What is the default display for this variable? We assume that - everything is "natural". Any exceptions? */ -static enum display_format -variable_default_display (var) - gdb_variable *var; -{ - return FORMAT_NATURAL; -} - -/* This function returns the type of a variable in the interpreter (or an error) - and returns either TCL_OK or TCL_ERROR as appropriate. */ -static int -variable_type (interp, objc, objv, var) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; - gdb_variable *var; -{ - int result; - value_ptr val; - char *first, *last, *string; - Tcl_RegExp regexp; - gdb_result r; - - if (var->value != NULL) - val = var->value; - else - { - r = GDB_evaluate_type (var->exp, &val); - if (r != GDB_OK) - return TCL_ERROR; - } - - result = call_gdb_type_print (val); - if (result == TCL_OK) - { - string = strdup (Tcl_GetStringFromObj (get_call_output (), NULL)); - first = string; - - /* gdb will print things out like "struct {...}" for anonymous structs. - In gui-land, we don't want the {...}, so we strip it here. */ - regexp = Tcl_RegExpCompile (interp, "{...}"); - if (Tcl_RegExpExec (interp, regexp, string, first)) - { - /* We have an anonymous struct/union/class/enum */ - Tcl_RegExpRange (regexp, 0, &first, &last); - if (*(first - 1) == ' ') - first--; - *first = '\0'; - } - - Tcl_SetObjResult (interp, Tcl_NewStringObj (string, -1)); - FREEIF (string); - return TCL_OK; - } - - Tcl_SetObjResult (interp, get_call_output ()); - return result; -} - -/* This function returns the value of a variable in the interpreter (or an error) - and returns either TCL_OK or TCL_ERROR as appropriate. */ -static int -variable_value (interp, objc, objv, var) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST objv[]; - gdb_variable *var; -{ - int result; - struct type *type; - value_ptr val; - Tcl_Obj *str; - gdb_result r; - int real_addressprint; - - /* If we set the value of the variable, objv[2] will contain the - variable's new value. We need to first construct a legal expression - for this -- ugh! */ - if (objc > 2) - { - /* Does this cover all the bases? */ - struct expression *exp; - value_ptr value; - int saved_input_radix = input_radix; - - if (VALUE_LVAL (var->value) != not_lval && var->value->modifiable) - { - char *s; - - input_radix = 10; /* ALWAYS reset to decimal temporarily */ - s = Tcl_GetStringFromObj (objv[2], NULL); - r = GDB_parse_exp_1 (&s, 0, 0, &exp); - if (r != GDB_OK) - return TCL_ERROR; - if (GDB_evaluate_expression (exp, &value) != GDB_OK) - return TCL_ERROR; - - val = value_assign (var->value, value); - value_free (var->value); - release_value (val); - var->value = val; - input_radix = saved_input_radix; - } - - return TCL_OK; - } - - if (var->value != NULL) - val = var->value; - else - { - /* This can happen if we attempt to get the value of a struct - member when the parent is an invalid pointer. - - GDB reports the error as the error derived from accessing the - parent, but we don't have access to that here... */ - Tcl_SetObjResult (interp, Tcl_NewStringObj ("???", -1)); - return TCL_ERROR; - } - - /* C++: addressprint causes val_print to print the - address of the reference, too. So clear it to get - the real value -- BUT ONLY FOR C++ REFERENCE TYPES! */ - real_addressprint = addressprint; - - /* BOGUS: if val_print sees a struct/class, it will print out its - children instead of "{...}" */ - type = get_type (val); - switch (TYPE_CODE (type)) - { - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - str = Tcl_NewStringObj ("{...}", -1); - break; - - case TYPE_CODE_ARRAY: - { - char number[256]; - str = Tcl_NewStringObj (NULL, 0); - sprintf (number, "%d", var->num_children); - Tcl_AppendStringsToObj (str, "[", number, "]", NULL); - } - break; - - case TYPE_CODE_REF: - /* Clear addressprint so that the actual value is printed */ - addressprint = 0; - - /* fall through */ - default: - result = call_gdb_val_print (val, format_code[(int) var->format]); - Tcl_SetObjResult (interp, get_call_output ()); - - /* Restore addressprint */ - addressprint = real_addressprint; - return result; - } - - /* We only get here if we encountered one of the "special types" above */ - - /* Restore addressprint */ - addressprint = real_addressprint; - - Tcl_SetObjResult (interp, str); - return TCL_OK; -} - -/* Is this variable editable? Use the variable's type to make - this determination. */ -static int -variable_editable (var) - gdb_variable *var; -{ - struct type *type; - int result; - gdb_result r; - - type = get_type (var->value); - if (type == NULL) - { - value_ptr val; - r = GDB_evaluate_type (var->exp, &val); - if (r != GDB_OK) - return 0; - type = get_type (val); - } - - switch (TYPE_CODE (type)) - { - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - case TYPE_CODE_ARRAY: - case TYPE_CODE_FUNC: - case TYPE_CODE_MEMBER: - case TYPE_CODE_METHOD: - result = 0; - break; - - default: - result = 1; - break; - } - - return result; -} - -/* - * Call stuff. These functions are used to capture the output of gdb commands - * without going through the tcl interpreter. - */ - -/* Retrieve gdb output in the buffer since last call. */ -static Tcl_Obj * -get_call_output () -{ - /* Clear the error flags, in case we errored. */ - if (result_ptr != NULL) - result_ptr->flags &= ~GDBTK_ERROR_ONLY; - return fputs_obj; -} - -/* Clear the output of the buffer. */ -static void -clear_gdb_output () -{ - if (fputs_obj != NULL) - Tcl_DecrRefCount (fputs_obj); - - fputs_obj = Tcl_NewStringObj (NULL, -1); - Tcl_IncrRefCount (fputs_obj); -} - -/* Call the gdb command "type_print", retaining its output in the buffer. */ -static int -call_gdb_type_print (val) - value_ptr val; -{ - void (*old_hook) PARAMS ((const char *, GDB_FILE *)); - int result; - - /* Save the old hook and install new hook */ - old_hook = fputs_unfiltered_hook; - fputs_unfiltered_hook = variable_fputs; - - /* Call our command with our args */ - clear_gdb_output (); - - - if (GDB_type_print (val, "", gdb_stdout, -1) == GDB_OK) - result = TCL_OK; - else - result = TCL_ERROR; - - /* Restore fputs hook */ - fputs_unfiltered_hook = old_hook; - - return result; -} - -/* Call the gdb command "val_print", retaining its output in the buffer. */ -static int -call_gdb_val_print (val, format) - value_ptr val; - int format; -{ - void (*old_hook) PARAMS ((const char *, GDB_FILE *)); - gdb_result r; - int result; - - /* Save the old hook and install new hook */ - old_hook = fputs_unfiltered_hook; - fputs_unfiltered_hook = variable_fputs; - - /* Call our command with our args */ - clear_gdb_output (); - - if (VALUE_LAZY (val)) - { - r = GDB_value_fetch_lazy (val); - if (r != GDB_OK) - { - fputs_unfiltered_hook = old_hook; - return TCL_ERROR; - } - } - r = GDB_val_print (VALUE_TYPE (val), VALUE_CONTENTS_RAW (val), VALUE_ADDRESS (val), - gdb_stdout, format, 1, 0, 0); - if (r == GDB_OK) - result = TCL_OK; - else - result = TCL_ERROR; - - /* Restore fputs hook */ - fputs_unfiltered_hook = old_hook; - - return result; -} - -/* The fputs_unfiltered_hook function used to save the output from one of the - call commands in this file. */ -static void -variable_fputs (text, stream) - const char *text; - GDB_FILE *stream; -{ - /* Just append everything to the fputs_obj... Issues with stderr/stdout? */ - Tcl_AppendToObj (fputs_obj, (char *) text, -1); -} - -/* Empty handler for the fputs_unfiltered_hook. Set the hook to this function - whenever the output is irrelevent. */ -static void -null_fputs (text, stream) - const char *text; - GDB_FILE *stream; -{ - return; -} - -/* - * Special wrapper-like stuff to supplement the generic wrappers - */ - -/* This returns the type of the variable. This skips past typedefs - and returns the real type of the variable. */ -static struct type * -get_type (val) - value_ptr val; -{ - struct type *type = NULL; - - if (val != NULL) - { - type = VALUE_TYPE (val); - while (type != NULL && TYPE_CODE (type) == TYPE_CODE_TYPEDEF) - type = TYPE_TARGET_TYPE (type); - } - - return type; -} - -/* This returns the target type (or NULL) of TYPE, also skipping - past typedefs, just like get_type (). */ -static struct type * -get_target_type (type) - struct type *type; -{ - if (type != NULL) - { - type = TYPE_TARGET_TYPE (type); - while (type != NULL && TYPE_CODE (type) == TYPE_CODE_TYPEDEF) - type = TYPE_TARGET_TYPE (type); - } - - return type; -} - -/* This function is a special wrap. This call never "fails".*/ -static int -my_value_equal (var, val2) - gdb_variable *var; - value_ptr val2; -{ - int err1, err2, r; - - /* This is bogus, but unfortunately necessary. We must know - exactly what caused an error -- reading var->val (which we - get from var->error and/or val2, so that we can really determine - if we think that something has changed. */ - err1 = var->error; - err2 = 0; - if (VALUE_LAZY (val2) && GDB_value_fetch_lazy (val2) != GDB_OK) - err2 = 1; - - /* Another special case: NULL values. If both are null, say - they're equal. */ - if (var->value == NULL && val2 == NULL) - return 1; - else if (var->value == NULL || val2 == NULL) - return 0; - - if (GDB_value_equal (var->value, val2, &r) != GDB_OK) - { - /* An error occurred, this could have happened if - either val1 or val2 errored. ERR1 and ERR2 tell - us which of these it is. If both errored, then - we assume nothing has changed. If one of them is - valid, though, then something has changed. */ - if (err1 == err2) - { - /* both the old and new values caused errors, so - we say the value did not change */ - /* This is indeterminate, though. Perhaps we should - be safe and say, yes, it changed anyway?? */ - return 1; - } - else - { - /* err2 replaces var->error since this new value - WILL replace the old one. */ - var->error = err2; - return 0; - } - } - - return r; -} - -/* Local variables: */ -/* change-log-default-name: "ChangeLog-gdbtk" */ -/* End: */ |