1 /* Variable user interface for GDB, the GNU debugger.
2 Copyright 1999 Free Software Foundation, Inc.
4 This file is part of GDB.
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
22 #include "expression.h"
29 #include "gdbtk-wrapper.h"
33 /* Enumeration type defining the return values for valueChanged */
36 VALUE_UNCHANGED
, /* the variable's value is unchanged */
37 VALUE_CHANGED
, /* the variable's value has changed */
38 VALUE_OUT_OF_SCOPE
/* the variable is no longer in scope */
41 /* String representations of the value_changed enums */
42 static char *value_changed_string
[] = {
45 "VARIABLE_OUT_OF_SCOPE",
49 /* Enumeration for the format types */
52 FORMAT_NATURAL
, /* What gdb actually calls 'natural' */
53 FORMAT_BINARY
, /* Binary display */
54 FORMAT_DECIMAL
, /* Decimal display */
55 FORMAT_HEXADECIMAL
, /* Hex display */
56 FORMAT_OCTAL
/* Octal display */
59 /* Mappings of display_format enums to gdb's format codes */
60 int format_code
[] = {0, 't', 'd', 'x', 'o'};
62 /* String representations of the format codes */
63 char *format_string
[] = {"natural", "binary", "decimal", "hexadecimal", "octal"};
65 /* Every parent variable keeps a linked list of its children, described
66 by the following structure. */
67 struct variable_child
{
69 /* Pointer to the child's data */
70 struct _gdb_variable
*child
;
72 /* Pointer to the next child */
73 struct variable_child
*next
;
76 /* Every variable in the system has a structure of this type defined
77 for it. This structure holds all information necessary to manipulate
78 a particular object variable. Members which must be freed are noted. */
79 struct _gdb_variable
{
81 /* Alloc'd name of the variable for this object.. If this variable is a
82 child, then this name will be the child's source name.
86 /* The alloc'd real name of this variable. This is used to construct the
87 variable's children. It is always a valid expression. */
90 /* The alloc'd name for this variable's object. This is here for
91 convenience when constructing this object's children. */
94 /* Alloc'd expression for this variable */
95 struct expression
*exp
;
97 /* Block for which this expression is valid */
98 struct block
*valid_block
;
100 /* The frame for this expression */
103 /* The value of this expression */
106 /* Did an error occur evaluating the expression or getting its value? */
109 /* The number of (immediate) children this variable has */
112 /* If this object is a child, this points to its parent. */
113 struct _gdb_variable
*parent
;
115 /* A list of this object's children */
116 struct variable_child
*children
;
118 /* The format of the output for this object */
119 enum display_format format
;
122 typedef struct _gdb_variable gdb_variable
;
124 /* This variable will hold the value of the output from gdb
125 for commands executed through call_gdb_* */
126 static Tcl_Obj
*fputs_obj
;
129 * Public functions defined in this file
132 int gdb_variable_init
PARAMS ((Tcl_Interp
*));
135 * Private functions defined in this file
138 /* Entries into this file */
140 static int gdb_variable_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
143 static int variable_create
PARAMS ((Tcl_Interp
*, int, Tcl_Obj
*CONST
[]));
145 static void variable_delete
PARAMS ((Tcl_Interp
*, gdb_variable
*));
147 static void variable_debug
PARAMS ((gdb_variable
*));
149 static int variable_obj_command
PARAMS ((ClientData
, Tcl_Interp
*, int,
151 static Tcl_Obj
*variable_children
PARAMS ((Tcl_Interp
*, gdb_variable
*));
153 static enum value_changed variable_value_changed
PARAMS ((gdb_variable
*));
155 static int variable_format
PARAMS ((Tcl_Interp
*, int, Tcl_Obj
*CONST
[],
158 static int variable_type
PARAMS ((Tcl_Interp
*, int, Tcl_Obj
*CONST
[],
161 static int variable_value
PARAMS ((Tcl_Interp
*, int, Tcl_Obj
*CONST
[],
164 static int variable_editable
PARAMS ((gdb_variable
*));
166 /* Helper functions for the above functions. */
168 static gdb_variable
*create_variable
PARAMS ((char *, char *, CORE_ADDR
));
170 static void delete_children
PARAMS ((Tcl_Interp
*, gdb_variable
*, int));
172 static void install_variable
PARAMS ((Tcl_Interp
*, char *, gdb_variable
*));
174 static void uninstall_variable
PARAMS ((Tcl_Interp
*, gdb_variable
*));
176 static gdb_variable
*child_exists
PARAMS ((gdb_variable
*, char *));
178 static gdb_variable
*create_child
PARAMS ((Tcl_Interp
*, gdb_variable
*,
180 static char *name_of_child
PARAMS ((gdb_variable
*, int));
182 static int number_of_children
PARAMS ((gdb_variable
*));
184 static enum display_format variable_default_display
PARAMS ((gdb_variable
*));
186 static void save_child_in_parent
PARAMS ((gdb_variable
*, gdb_variable
*));
188 static void remove_child_from_parent
PARAMS ((gdb_variable
*, gdb_variable
*));
190 static struct type
*get_type
PARAMS ((value_ptr
));
192 static struct type
*get_target_type
PARAMS ((struct type
*));
194 static Tcl_Obj
*get_call_output
PARAMS ((void));
196 static void clear_gdb_output
PARAMS ((void));
198 static int call_gdb_type_print
PARAMS ((value_ptr
));
200 static int call_gdb_val_print
PARAMS ((value_ptr
, int));
202 static void variable_fputs
PARAMS ((const char *, GDB_FILE
*));
204 static void null_fputs
PARAMS ((const char *, GDB_FILE
*));
206 static int my_value_equal
PARAMS ((gdb_variable
*, value_ptr
));
208 #define INIT_VARIABLE(x) { \
210 (x)->real_name = NULL; \
211 (x)->obj_name = NULL; \
213 (x)->valid_block = NULL; \
214 (x)->frame = (CORE_ADDR) 0; \
217 (x)->num_children = 0; \
218 (x)->parent = NULL; \
219 (x)->children = NULL; \
220 (x)->format = FORMAT_NATURAL; \
226 #define FREEIF(x) if (x != NULL) free((char *) (x))
228 /* Initialize the variable code. This function should be called once
229 to install and initialize the variable code into the interpreter. */
231 gdb_variable_init (interp
)
236 result
= Tcl_CreateObjCommand (interp
, "gdb_variable", call_wrapper
,
237 (ClientData
) gdb_variable_command
, NULL
);
244 /* This function defines the "gdb_variable" command which is used to
245 create variable objects. Its syntax includes:
248 gdb_variable create NAME
249 gdb_variable create -expr EXPR
250 gdb_variable create NAME -expr EXPR
252 NAME = name of object to create. If no NAME, then automatically create
254 EXPR = the gdb expression for which to create a variable. This will
255 be the most common usage.
258 gdb_variable_command (clientData
, interp
, objc
, objv
)
259 ClientData clientData
;
262 Tcl_Obj
*CONST objv
[];
264 static char *commands
[] = { "create", NULL
};
265 enum commands_enum
{ VARIABLE_CREATE
};
270 Tcl_WrongNumArgs (interp
, 1, objv
, "option ?arg...?");
274 if (Tcl_GetIndexFromObj (interp
, objv
[1], commands
, "options", 0,
280 switch ((enum commands_enum
) index
)
282 case VARIABLE_CREATE
:
283 result
= variable_create (interp
, objc
- 2, objv
+ 2);
293 /* This function implements the actual object command for each
294 variable object that is created (and each of its children).
296 Currently the following commands are implemented:
297 - delete delete this object and its children
298 - valueChanged has the value of this object changed since the last check?
299 - numChildren how many children does this object have
300 - children create the children and return a list of their objects
301 - debug print out a little debug info for the object
302 - name print out the name of this variable
305 variable_obj_command (clientData
, interp
, objc
, objv
)
306 ClientData clientData
;
309 Tcl_Obj
*CONST objv
[];
313 VARIABLE_VALUE_CHANGED
,
314 VARIABLE_NUM_CHILDREN
,
323 static char *commands
[] = {
336 gdb_variable
*var
= (gdb_variable
*) clientData
;
341 Tcl_WrongNumArgs (interp
, 1, objv
, "option ?arg...?");
345 if (Tcl_GetIndexFromObj (interp
, objv
[1], commands
, "options", 0,
350 switch ((enum commands_enum
) index
)
352 case VARIABLE_DELETE
:
356 char *s
= Tcl_GetStringFromObj (objv
[2], &len
);
357 if (*s
== 'c' && strncmp (s
, "children", len
) == 0)
359 delete_children (interp
, var
, 1);
363 variable_delete (interp
, var
);
366 case VARIABLE_VALUE_CHANGED
:
368 enum value_changed vc
= variable_value_changed (var
);
369 Tcl_SetObjResult (interp
, Tcl_NewStringObj (value_changed_string
[vc
], -1));
373 case VARIABLE_NUM_CHILDREN
:
374 Tcl_SetObjResult (interp
, Tcl_NewIntObj (var
->num_children
));
377 case VARIABLE_CHILDREN
:
379 Tcl_Obj
*children
= variable_children (interp
, var
);
380 Tcl_SetObjResult (interp
, children
);
385 variable_debug (var
);
388 case VARIABLE_FORMAT
:
389 result
= variable_format (interp
, objc
, objv
, var
);
393 result
= variable_type (interp
, objc
, objv
, var
);
397 result
= variable_value (interp
, objc
, objv
, var
);
401 Tcl_SetObjResult (interp
, Tcl_NewStringObj (var
->name
, -1));
404 case VARIABLE_EDITABLE
:
405 Tcl_SetObjResult (interp
, Tcl_NewIntObj (variable_editable (var
)));
416 * Variable object construction/destruction
419 /* This function is responsible for processing the user's specifications
420 and constructing a variable object. */
422 variable_create (interp
, objc
, objv
)
425 Tcl_Obj
*CONST objv
[];
427 enum create_opts
{ CREATE_EXPR
, CREATE_PC
};
428 static char *create_options
[] = { "-expr", "-pc", NULL
};
434 CORE_ADDR pc
= (CORE_ADDR
) -1;
436 /* REMINDER: This command may be invoked in the following ways:
438 gdb_variable create NAME
439 gdb_variable create -expr EXPR
440 gdb_variable create NAME -expr EXPR
442 NAME = name of object to create. If no NAME, then automatically create
444 EXPR = the gdb expression for which to create a variable. This will
445 be the most common usage.
449 name
= Tcl_GetStringFromObj (objv
[0], NULL
);
450 if (name
== NULL
|| *name
== '-')
452 /* generate a name for this object */
454 sprintf (obj_name
, "var%d", id
);
458 /* specified name for object */
459 strncpy (obj_name
, name
, 30);
464 /* Run through all the possible options for this command */
468 if (Tcl_GetIndexFromObj (interp
, objv
[0], create_options
, "options",
469 0, &index
) != TCL_OK
)
471 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
475 switch ((enum create_opts
) index
)
478 name
= Tcl_GetStringFromObj (objv
[1], NULL
);
486 str
= Tcl_GetStringFromObj (objv
[1], NULL
);
487 pc
= parse_and_eval_address (str
);
501 /* Create the variable */
502 var
= create_variable (name
, name
, pc
);
506 /* Install a command into the interpreter that represents this
508 install_variable (interp
, obj_name
, var
);
509 Tcl_SetObjResult (interp
, Tcl_NewStringObj (obj_name
, -1));
510 result_ptr
->flags
|= GDBTK_IN_TCL_RESULT
;
518 /* Fill out a gdb_variable structure for the variable being constructed.
519 This function should never fail if real_name is a valid expression.
520 (That means no longjmp'ing!) */
521 static gdb_variable
*
522 create_variable (name
, real_name
, pc
)
529 struct frame_info
*fi
, *old_fi
;
531 void (*old_fputs
) PARAMS ((const char *, GDB_FILE
*));
534 var
= (gdb_variable
*) xmalloc (sizeof (gdb_variable
));
541 /* Parse and evaluate the expression, filling in as much
542 of the variable's data as possible */
544 /* Allow creator to specify context of variable */
545 if (pc
== (CORE_ADDR
) -1)
549 r
= GDB_block_for_pc (pc
, &block
);
555 innermost_block
= NULL
;
556 r
= GDB_parse_exp_1 (&p
, block
, 0, &(var
->exp
));
559 FREEIF ((char *) var
);
563 /* Don't allow variables to be created for types. */
564 if (var
->exp
->elts
[0].opcode
== OP_TYPE
)
566 free_current_contents ((char **) &(var
->exp
));
568 printf_unfiltered ("Attempt to use a type name as an expression.");
572 var
->valid_block
= innermost_block
;
573 var
->name
= savestring (name
, strlen (name
));
574 var
->real_name
= savestring (real_name
, strlen (real_name
));
576 /* Several of the GDB_* calls can cause messages to be displayed. We swallow
577 those here, because we don't need them (the "value" command will
579 old_fputs
= fputs_unfiltered_hook
;
580 fputs_unfiltered_hook
= null_fputs
;
582 /* When the PC is different from the current PC (pc == -1),
583 then we must select the appropriate frame before parsing
584 the expression, otherwise the value will not be current.
585 Since select_frame is so benign, just call it for all cases. */
586 r
= GDB_block_innermost_frame (var
->valid_block
, &fi
);
590 var
->frame
= FRAME_FP (fi
);
591 old_fi
= selected_frame
;
592 GDB_select_frame (fi
, -1);
594 mark
= value_mark ();
595 if (GDB_evaluate_expression (var
->exp
, &var
->value
) == GDB_OK
)
597 release_value (var
->value
);
598 if (VALUE_LAZY (var
->value
))
600 if (GDB_value_fetch_lazy (var
->value
) != GDB_OK
)
608 value_free_to_mark (mark
);
610 /* Reset the selected frame */
611 GDB_select_frame (old_fi
, -1);
613 /* Restore the output hook to normal */
614 fputs_unfiltered_hook
= old_fputs
;
616 var
->num_children
= number_of_children (var
);
617 var
->format
= variable_default_display (var
);
623 /* Install the given variable VAR into the tcl interpreter with
624 the object name NAME. */
626 install_variable (interp
, name
, var
)
631 var
->obj_name
= savestring (name
, strlen (name
));
632 Tcl_CreateObjCommand (interp
, name
, variable_obj_command
,
633 (ClientData
) var
, NULL
);
636 /* Unistall the object VAR in the tcl interpreter. */
638 uninstall_variable (interp
, var
)
642 Tcl_DeleteCommand (interp
, var
->obj_name
);
645 /* Delete the variable object VAR and its children */
647 variable_delete (interp
, var
)
651 /* Delete any children of this variable, too. */
652 delete_children (interp
, var
, 0);
654 /* If this variable has a parent, remove it from its parent's list */
655 if (var
->parent
!= NULL
)
657 remove_child_from_parent (var
->parent
, var
);
660 uninstall_variable (interp
, var
);
662 /* Free memory associated with this variable */
664 FREEIF (var
->real_name
);
665 FREEIF (var
->obj_name
);
666 if (var
->exp
!= NULL
)
667 free_current_contents ((char **) &var
->exp
);
671 /* Silly debugging info */
678 str
= Tcl_NewStringObj ("name=", -1);
679 Tcl_AppendStringsToObj (str
, var
->name
, "\nreal_name=", var
->real_name
,
680 "\nobj_name=", var
->obj_name
, NULL
);
681 Tcl_SetObjResult (gdbtk_interp
, str
);
685 * Child construction/destruction
688 /* Delete the children associated with the object VAR. If NOTIFY is set,
689 notify the parent object that this child was deleted. This is used as
690 a small optimization when deleting variables and their children. If the
691 parent is also being deleted, don't bother notifying it that its children
692 are being deleted. */
694 delete_children (interp
, var
, notify
)
699 struct variable_child
*vc
;
700 struct variable_child
*next
;
702 for (vc
= var
->children
; vc
!= NULL
; vc
= next
)
705 vc
->child
->parent
= NULL
;
706 variable_delete (interp
, vc
->child
);
712 /* Return the number of children for a given variable.
714 This can get a little complicated, since we would like to make
715 certain assumptions about certain types of variables.
717 - struct/union *: dereference first
718 - (*)(): do not allow derefencing
720 - declared size = num of children or
721 - -1 if we don't know, i.e., int foo [];
722 - if there was an error reported constructing this object,
723 assume it has no children (and try this again later)
724 - void * and char * have no children
727 number_of_children (var
)
734 if (var
->value
!= NULL
)
736 type
= get_type (var
->value
);
737 target
= get_target_type (type
);
740 switch (TYPE_CODE (type
))
742 case TYPE_CODE_ARRAY
:
743 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (target
) > 0
744 && TYPE_ARRAY_UPPER_BOUND_TYPE (type
) != BOUND_CANNOT_BE_DETERMINED
)
745 children
= TYPE_LENGTH (type
) / TYPE_LENGTH (target
);
750 case TYPE_CODE_STRUCT
:
751 case TYPE_CODE_UNION
:
752 /* If we have a virtual table pointer, omit it. */
753 if (TYPE_VPTR_BASETYPE (type
) == type
754 && !(TYPE_VPTR_FIELDNO (type
) < 0))
755 children
= TYPE_NFIELDS (type
) - 1;
757 children
= TYPE_NFIELDS (type
);
761 /* This is where things get compilcated. All pointers have one child.
762 Except, of course, for struct and union ptr, which we automagically
763 dereference for the user and function ptrs, which have no children. */
764 switch (TYPE_CODE (target
))
766 case TYPE_CODE_STRUCT
:
767 case TYPE_CODE_UNION
:
768 /* If we have a virtual table pointer, omit it. */
769 if (TYPE_VPTR_BASETYPE (target
) == target
770 && !(TYPE_VPTR_FIELDNO (target
) < 0))
771 children
= TYPE_NFIELDS (target
) - 1;
773 children
= TYPE_NFIELDS (target
);
781 /* Don't dereference char* or void*. */
782 if (TYPE_NAME (target
) != NULL
783 && (STREQ (TYPE_NAME (target
), "char")
784 || STREQ (TYPE_NAME (target
), "void")))
797 /* var->value can be null if we tried to access non-existent or
798 protected memory. In this case, we simply do not allow any
799 children. This will be checked again when we check if its
800 value has changed. */
807 /* Return a list of all the children of VAR, creating them if necessary. */
809 variable_children (interp
, var
)
818 list
= Tcl_NewListObj (0, NULL
);
819 for (i
= 0; i
< var
->num_children
; i
++)
821 /* check if child exists */
822 name
= name_of_child (var
, i
);
823 child
= child_exists (var
, name
);
826 child
= create_child (interp
, var
, name
, i
);
828 /* name_of_child returns a malloc'd string */
831 Tcl_ListObjAppendElement (NULL
, list
, Tcl_NewStringObj (child
->obj_name
, -1));
837 /* Does a child with the name NAME exist in VAR? If so, return its data.
838 If not, return NULL. */
839 static gdb_variable
*
840 child_exists (var
, name
)
841 gdb_variable
*var
; /* Parent */
842 char *name
; /* name of child */
844 struct variable_child
*vc
;
846 for (vc
= var
->children
; vc
!= NULL
; vc
= vc
->next
)
848 if (STREQ (vc
->child
->name
, name
))
855 /* Create and install a child of the parent of the given name */
856 static gdb_variable
*
857 create_child (interp
, parent
, name
, index
)
859 gdb_variable
*parent
;
866 char separator
[10], prefix
[2048], suffix
[20];
872 /* name should never be null. For pointer derefs, it should contain "*name".
873 For arrays of a known size, the name will simply contain the index into
881 /* This code must contain a lot of the logic for children based on the parent's
883 type
= get_type (parent
->value
);
884 target
= get_target_type (type
);
886 switch (TYPE_CODE (type
))
888 case TYPE_CODE_ARRAY
:
889 sprintf (suffix
, "[%s]", name
);
893 case TYPE_CODE_STRUCT
:
894 case TYPE_CODE_UNION
:
895 if (index
< TYPE_N_BASECLASSES (type
))
897 strcpy (prefix
, "((");
898 strcat (prefix
, name
);
899 strcat (prefix
, ")");
900 strcpy (suffix
, ") ");
904 strcpy (separator
, ".");
908 switch (TYPE_CODE (target
))
910 case TYPE_CODE_STRUCT
:
911 case TYPE_CODE_UNION
:
912 if (index
< TYPE_N_BASECLASSES (target
))
914 strcpy (prefix
, "(*(");
915 strcat (prefix
, name
);
916 strcat (prefix
, " *)");
917 strcpy (suffix
, ")");
921 strcpy (separator
, "->");
933 /* When we get here, we should know how to construct a legal
934 expression for the child's name */
935 len
= strlen (prefix
);
936 len
+= strlen (parent
->real_name
);
937 len
+= strlen (separator
);
938 len
+= strlen (name
);
939 len
+= strlen (suffix
);
942 childs_name
= (char *) xmalloc ((len
+ 1) * sizeof (char));
945 strcpy (childs_name
, "(*");
946 strcat (childs_name
, parent
->real_name
);
947 strcat (childs_name
, suffix
);
948 strcat (childs_name
, ")");
952 strcpy (childs_name
, prefix
);
953 strcat (childs_name
, parent
->real_name
);
954 strcat (childs_name
, separator
);
955 strcat (childs_name
, name
);
956 strcat (childs_name
, suffix
);
959 /* childs_name now contains a valid expression for the child */
960 child
= create_variable (save_name
, childs_name
, (CORE_ADDR
) -1);
961 child
->parent
= parent
;
963 childs_name
= (char *) xmalloc ((strlen (parent
->obj_name
) + strlen (save_name
) + 2)
965 sprintf (childs_name
, "%s.%s", parent
->obj_name
, save_name
);
966 install_variable (interp
, childs_name
, child
);
969 /* Save a pointer to this child in the parent */
970 save_child_in_parent (parent
, child
);
975 /* Save CHILD in the PARENT's data. */
977 save_child_in_parent (parent
, child
)
978 gdb_variable
*parent
;
981 struct variable_child
*vc
;
983 /* Insert the child at the top */
984 vc
= parent
->children
;
986 (struct variable_child
*) xmalloc (sizeof (struct variable_child
));
988 parent
->children
->next
= vc
;
989 parent
->children
->child
= child
;
992 /* Remove the CHILD from the PARENT's list of children. */
994 remove_child_from_parent (parent
, child
)
995 gdb_variable
*parent
;
998 struct variable_child
*vc
, *prev
;
1000 /* Find the child in the parent's list */
1002 for (vc
= parent
->children
; vc
!= NULL
; )
1004 if (vc
->child
== child
)
1011 parent
->children
= vc
->next
;
1013 prev
->next
= vc
->next
;
1017 /* What is the name of the INDEX'th child of VAR? */
1019 name_of_child (var
, index
)
1024 struct type
*target
;
1028 type
= get_type (var
->value
);
1029 target
= get_target_type (type
);
1031 switch (TYPE_CODE (type
))
1033 case TYPE_CODE_ARRAY
:
1035 /* We never get here unless var->num_children is greater than 0... */
1037 while ((int) pow ((double) 10, (double) len
) < index
)
1039 name
= (char *) xmalloc (1 + len
* sizeof (char));
1040 sprintf (name
, "%d", index
);
1044 case TYPE_CODE_STRUCT
:
1045 case TYPE_CODE_UNION
:
1046 string
= TYPE_FIELD_NAME (type
, index
);
1047 name
= savestring (string
, strlen (string
));
1051 switch (TYPE_CODE (target
))
1053 case TYPE_CODE_STRUCT
:
1054 case TYPE_CODE_UNION
:
1055 string
= TYPE_FIELD_NAME (target
, index
);
1056 name
= savestring (string
, strlen (string
));
1060 name
= (char *) xmalloc ((strlen (var
->name
) + 2) * sizeof (char));
1061 sprintf (name
, "*%s", var
->name
);
1069 /* Has the value of this object changed since the last time we looked?
1071 There are some special cases:
1072 - structs/unions/arrays. The "value" of these never changes.
1073 Only their children's values change.
1074 - if an error occurred with evaluate_expression or fetch_value_lazy,
1075 then we need to be a little more elaborate with our determination
1076 of "value changed". Specifically, the value does not change when
1077 both the previous evaluate fails and the one done here also fails.
1079 static enum value_changed
1080 variable_value_changed (var
)
1083 value_ptr mark
, new_val
;
1084 struct frame_info
*fi
, *old_fi
;
1086 enum value_changed result
;
1089 /* Save the selected stack frame, since we will need to change it
1090 in order to evaluate expressions. */
1091 old_fi
= selected_frame
;
1093 /* Determine whether the variable is still around. */
1094 if (var
->valid_block
== NULL
)
1098 GDB_reinit_frame_cache ();
1099 r
= GDB_find_frame_addr_in_frame_chain (var
->frame
, &fi
);
1102 within_scope
= fi
!= NULL
;
1103 /* FIXME: GDB_select_frame could fail */
1105 GDB_select_frame (fi
, -1);
1108 result
= VALUE_OUT_OF_SCOPE
;
1111 struct type
*type
= get_type (var
->value
);
1113 /* Arrays, struct, classes, unions never change value */
1114 if (type
!= NULL
&& (TYPE_CODE (type
) == TYPE_CODE_STRUCT
1115 || TYPE_CODE (type
) == TYPE_CODE_UNION
1116 || TYPE_CODE (type
) == TYPE_CODE_ARRAY
))
1117 result
= VALUE_UNCHANGED
;
1120 mark
= value_mark ();
1121 if (GDB_evaluate_expression (var
->exp
, &new_val
) == GDB_OK
)
1123 if (!my_value_equal (var
, new_val
))
1126 release_value (new_val
);
1127 if (var
->value
== NULL
)
1129 /* This can happen if there was an error
1130 evaluating the expression (like deref NULL) */
1131 var
->num_children
= number_of_children (var
);
1133 value_free (var
->value
);
1134 var
->value
= new_val
;
1135 result
= VALUE_CHANGED
;
1138 result
= VALUE_UNCHANGED
;
1142 /* evaluate expression failed. If we failed before, then
1143 the value of this variable has not changed. If we
1144 succeed before, then the value did change. */
1145 if (var
->value
== NULL
)
1146 result
= VALUE_UNCHANGED
;
1151 result
= VALUE_CHANGED
;
1155 value_free_to_mark (mark
);
1159 /* Restore selected frame */
1160 GDB_select_frame (old_fi
, -1);
1166 variable_format (interp
, objc
, objv
, var
)
1169 Tcl_Obj
*CONST objv
[];
1175 /* Set the format of VAR to given format */
1177 char *fmt
= Tcl_GetStringFromObj (objv
[2], &len
);
1178 if (STREQN (fmt
, "natural", len
))
1179 var
->format
= FORMAT_NATURAL
;
1180 else if (STREQN (fmt
, "binary", len
))
1181 var
->format
= FORMAT_NATURAL
;
1182 else if (STREQN (fmt
, "decimal", len
))
1183 var
->format
= FORMAT_DECIMAL
;
1184 else if (STREQN (fmt
, "hexadecimal", len
))
1185 var
->format
= FORMAT_HEXADECIMAL
;
1186 else if (STREQN (fmt
, "octal", len
))
1187 var
->format
= FORMAT_OCTAL
;
1190 Tcl_Obj
*obj
= Tcl_NewStringObj (NULL
, 0);
1191 Tcl_AppendStringsToObj (obj
, "unknown display format \"",
1192 fmt
, "\": must be: \"natural\", \"binary\""
1193 ", \"decimal\", \"hexadecimal\", or \"octal\"",
1195 Tcl_SetObjResult (interp
, obj
);
1201 /* Report the current format */
1204 fmt
= Tcl_NewStringObj (format_string
[(int) var
->format
], -1);
1205 Tcl_SetObjResult (interp
, fmt
);
1211 /* What is the default display for this variable? We assume that
1212 everything is "natural". Any exceptions? */
1213 static enum display_format
1214 variable_default_display (var
)
1217 return FORMAT_NATURAL
;
1220 /* This function returns the type of a variable in the interpreter (or an error)
1221 and returns either TCL_OK or TCL_ERROR as appropriate. */
1223 variable_type (interp
, objc
, objv
, var
)
1226 Tcl_Obj
*CONST objv
[];
1231 char *first
, *last
, *string
;
1235 if (var
->value
!= NULL
)
1239 r
= GDB_evaluate_type (var
->exp
, &val
);
1244 result
= call_gdb_type_print (val
);
1245 if (result
== TCL_OK
)
1247 string
= strdup (Tcl_GetStringFromObj (get_call_output (), NULL
));
1250 /* gdb will print things out like "struct {...}" for anonymous structs.
1251 In gui-land, we don't want the {...}, so we strip it here. */
1252 regexp
= Tcl_RegExpCompile (interp
, "{...}");
1253 if (Tcl_RegExpExec (interp
, regexp
, string
, first
))
1255 /* We have an anonymous struct/union/class/enum */
1256 Tcl_RegExpRange (regexp
, 0, &first
, &last
);
1257 if (*(first
- 1) == ' ')
1262 Tcl_SetObjResult (interp
, Tcl_NewStringObj (string
, -1));
1267 Tcl_SetObjResult (interp
, get_call_output ());
1271 /* This function returns the value of a variable in the interpreter (or an error)
1272 and returns either TCL_OK or TCL_ERROR as appropriate. */
1274 variable_value (interp
, objc
, objv
, var
)
1277 Tcl_Obj
*CONST objv
[];
1285 int real_addressprint
;
1287 /* If we set the value of the variable, objv[2] will contain the
1288 variable's new value. We need to first construct a legal expression
1292 /* Does this cover all the bases? */
1293 struct expression
*exp
;
1295 int saved_input_radix
= input_radix
;
1297 if (VALUE_LVAL (var
->value
) != not_lval
&& var
->value
->modifiable
)
1301 input_radix
= 10; /* ALWAYS reset to decimal temporarily */
1302 s
= Tcl_GetStringFromObj (objv
[2], NULL
);
1303 r
= GDB_parse_exp_1 (&s
, 0, 0, &exp
);
1306 if (GDB_evaluate_expression (exp
, &value
) != GDB_OK
)
1309 val
= value_assign (var
->value
, value
);
1310 value_free (var
->value
);
1311 release_value (val
);
1313 input_radix
= saved_input_radix
;
1319 if (var
->value
!= NULL
)
1323 /* This can happen if we attempt to get the value of a struct
1324 member when the parent is an invalid pointer.
1326 GDB reports the error as the error derived from accessing the
1327 parent, but we don't have access to that here... */
1328 Tcl_SetObjResult (interp
, Tcl_NewStringObj ("???", -1));
1332 /* C++: addressprint causes val_print to print the
1333 address of the reference, too. So clear it to get
1334 the real value -- BUT ONLY FOR C++ REFERENCE TYPES! */
1335 real_addressprint
= addressprint
;
1337 /* BOGUS: if val_print sees a struct/class, it will print out its
1338 children instead of "{...}" */
1339 type
= get_type (val
);
1340 switch (TYPE_CODE (type
))
1342 case TYPE_CODE_STRUCT
:
1343 case TYPE_CODE_UNION
:
1344 str
= Tcl_NewStringObj ("{...}", -1);
1347 case TYPE_CODE_ARRAY
:
1350 str
= Tcl_NewStringObj (NULL
, 0);
1351 sprintf (number
, "%d", var
->num_children
);
1352 Tcl_AppendStringsToObj (str
, "[", number
, "]", NULL
);
1357 /* Clear addressprint so that the actual value is printed */
1362 result
= call_gdb_val_print (val
, format_code
[(int) var
->format
]);
1363 Tcl_SetObjResult (interp
, get_call_output ());
1365 /* Restore addressprint */
1366 addressprint
= real_addressprint
;
1370 /* We only get here if we encountered one of the "special types" above */
1372 /* Restore addressprint */
1373 addressprint
= real_addressprint
;
1375 Tcl_SetObjResult (interp
, str
);
1379 /* Is this variable editable? Use the variable's type to make
1380 this determination. */
1382 variable_editable (var
)
1389 type
= get_type (var
->value
);
1393 r
= GDB_evaluate_type (var
->exp
, &val
);
1396 type
= get_type (val
);
1399 switch (TYPE_CODE (type
))
1401 case TYPE_CODE_STRUCT
:
1402 case TYPE_CODE_UNION
:
1403 case TYPE_CODE_ARRAY
:
1404 case TYPE_CODE_FUNC
:
1405 case TYPE_CODE_MEMBER
:
1406 case TYPE_CODE_METHOD
:
1419 * Call stuff. These functions are used to capture the output of gdb commands
1420 * without going through the tcl interpreter.
1423 /* Retrieve gdb output in the buffer since last call. */
1427 /* Clear the error flags, in case we errored. */
1428 if (result_ptr
!= NULL
)
1429 result_ptr
->flags
&= ~GDBTK_ERROR_ONLY
;
1433 /* Clear the output of the buffer. */
1437 if (fputs_obj
!= NULL
)
1438 Tcl_DecrRefCount (fputs_obj
);
1440 fputs_obj
= Tcl_NewStringObj (NULL
, -1);
1441 Tcl_IncrRefCount (fputs_obj
);
1444 /* Call the gdb command "type_print", retaining its output in the buffer. */
1446 call_gdb_type_print (val
)
1449 void (*old_hook
) PARAMS ((const char *, GDB_FILE
*));
1452 /* Save the old hook and install new hook */
1453 old_hook
= fputs_unfiltered_hook
;
1454 fputs_unfiltered_hook
= variable_fputs
;
1456 /* Call our command with our args */
1457 clear_gdb_output ();
1460 if (GDB_type_print (val
, "", gdb_stdout
, -1) == GDB_OK
)
1465 /* Restore fputs hook */
1466 fputs_unfiltered_hook
= old_hook
;
1471 /* Call the gdb command "val_print", retaining its output in the buffer. */
1473 call_gdb_val_print (val
, format
)
1477 void (*old_hook
) PARAMS ((const char *, GDB_FILE
*));
1481 /* Save the old hook and install new hook */
1482 old_hook
= fputs_unfiltered_hook
;
1483 fputs_unfiltered_hook
= variable_fputs
;
1485 /* Call our command with our args */
1486 clear_gdb_output ();
1488 if (VALUE_LAZY (val
))
1490 r
= GDB_value_fetch_lazy (val
);
1493 fputs_unfiltered_hook
= old_hook
;
1497 r
= GDB_val_print (VALUE_TYPE (val
), VALUE_CONTENTS_RAW (val
), VALUE_ADDRESS (val
),
1498 gdb_stdout
, format
, 1, 0, 0);
1504 /* Restore fputs hook */
1505 fputs_unfiltered_hook
= old_hook
;
1510 /* The fputs_unfiltered_hook function used to save the output from one of the
1511 call commands in this file. */
1513 variable_fputs (text
, stream
)
1517 /* Just append everything to the fputs_obj... Issues with stderr/stdout? */
1518 Tcl_AppendToObj (fputs_obj
, (char *) text
, -1);
1521 /* Empty handler for the fputs_unfiltered_hook. Set the hook to this function
1522 whenever the output is irrelevent. */
1524 null_fputs (text
, stream
)
1532 * Special wrapper-like stuff to supplement the generic wrappers
1535 /* This returns the type of the variable. This skips past typedefs
1536 and returns the real type of the variable. */
1537 static struct type
*
1541 struct type
*type
= NULL
;
1545 type
= VALUE_TYPE (val
);
1546 while (type
!= NULL
&& TYPE_CODE (type
) == TYPE_CODE_TYPEDEF
)
1547 type
= TYPE_TARGET_TYPE (type
);
1553 /* This returns the target type (or NULL) of TYPE, also skipping
1554 past typedefs, just like get_type (). */
1555 static struct type
*
1556 get_target_type (type
)
1561 type
= TYPE_TARGET_TYPE (type
);
1562 while (type
!= NULL
&& TYPE_CODE (type
) == TYPE_CODE_TYPEDEF
)
1563 type
= TYPE_TARGET_TYPE (type
);
1569 /* This function is a special wrap. This call never "fails".*/
1571 my_value_equal (var
, val2
)
1577 /* This is bogus, but unfortunately necessary. We must know
1578 exactly what caused an error -- reading var->val (which we
1579 get from var->error and/or val2, so that we can really determine
1580 if we think that something has changed. */
1583 if (VALUE_LAZY (val2
) && GDB_value_fetch_lazy (val2
) != GDB_OK
)
1586 /* Another special case: NULL values. If both are null, say
1588 if (var
->value
== NULL
&& val2
== NULL
)
1590 else if (var
->value
== NULL
|| val2
== NULL
)
1593 if (GDB_value_equal (var
->value
, val2
, &r
) != GDB_OK
)
1595 /* An error occurred, this could have happened if
1596 either val1 or val2 errored. ERR1 and ERR2 tell
1597 us which of these it is. If both errored, then
1598 we assume nothing has changed. If one of them is
1599 valid, though, then something has changed. */
1602 /* both the old and new values caused errors, so
1603 we say the value did not change */
1604 /* This is indeterminate, though. Perhaps we should
1605 be safe and say, yes, it changed anyway?? */
1610 /* err2 replaces var->error since this new value
1611 WILL replace the old one. */
1620 /* Local variables: */
1621 /* change-log-default-name: "ChangeLog-gdbtk" */