Commit | Line | Data |
---|---|---|
c98fe0c1 JI |
1 | /* Variable user interface for GDB, the GNU debugger. |
2 | Copyright 1999 Free Software Foundation, Inc. | |
3 | ||
4 | This file is part of GDB. | |
5 | ||
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. | |
10 | ||
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. | |
15 | ||
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. */ | |
19 | ||
20 | #include "defs.h" | |
21 | #include "value.h" | |
22 | #include "expression.h" | |
23 | #include "frame.h" | |
24 | #include "valprint.h" | |
25 | ||
26 | #include <tcl.h> | |
27 | #include <tk.h> | |
28 | #include "gdbtk.h" | |
29 | #include "gdbtk-wrapper.h" | |
30 | ||
31 | #include <math.h> | |
32 | ||
33 | /* Enumeration type defining the return values for valueChanged */ | |
34 | enum value_changed | |
35 | { | |
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 */ | |
39 | }; | |
40 | ||
41 | /* String representations of the value_changed enums */ | |
42 | static char *value_changed_string[] = { | |
43 | "VARIABLE_UNCHANGED", | |
44 | "VARIABLE_CHANGED", | |
45 | "VARIABLE_OUT_OF_SCOPE", | |
46 | NULL | |
47 | }; | |
48 | ||
49 | /* Enumeration for the format types */ | |
50 | enum display_format | |
51 | { | |
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 */ | |
57 | }; | |
58 | ||
59 | /* Mappings of display_format enums to gdb's format codes */ | |
60 | int format_code[] = {0, 't', 'd', 'x', 'o'}; | |
61 | ||
62 | /* String representations of the format codes */ | |
63 | char *format_string[] = {"natural", "binary", "decimal", "hexadecimal", "octal"}; | |
64 | ||
65 | /* Every parent variable keeps a linked list of its children, described | |
66 | by the following structure. */ | |
67 | struct variable_child { | |
68 | ||
69 | /* Pointer to the child's data */ | |
70 | struct _gdb_variable *child; | |
71 | ||
72 | /* Pointer to the next child */ | |
73 | struct variable_child *next; | |
74 | }; | |
75 | ||
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 { | |
80 | ||
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. | |
83 | (bar, not foo.bar) */ | |
84 | char *name; | |
85 | ||
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. */ | |
88 | char *real_name; | |
89 | ||
90 | /* The alloc'd name for this variable's object. This is here for | |
91 | convenience when constructing this object's children. */ | |
92 | char *obj_name; | |
93 | ||
94 | /* Alloc'd expression for this variable */ | |
95 | struct expression *exp; | |
96 | ||
97 | /* Block for which this expression is valid */ | |
98 | struct block *valid_block; | |
99 | ||
100 | /* The frame for this expression */ | |
101 | CORE_ADDR frame; | |
102 | ||
103 | /* The value of this expression */ | |
104 | value_ptr value; | |
105 | ||
106 | /* Did an error occur evaluating the expression or getting its value? */ | |
107 | int error; | |
108 | ||
109 | /* The number of (immediate) children this variable has */ | |
110 | int num_children; | |
111 | ||
112 | /* If this object is a child, this points to its parent. */ | |
113 | struct _gdb_variable *parent; | |
114 | ||
115 | /* A list of this object's children */ | |
116 | struct variable_child *children; | |
117 | ||
118 | /* The format of the output for this object */ | |
119 | enum display_format format; | |
120 | }; | |
121 | ||
122 | typedef struct _gdb_variable gdb_variable; | |
123 | ||
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; | |
127 | ||
128 | /* | |
129 | * Public functions defined in this file | |
130 | */ | |
131 | ||
132 | int gdb_variable_init PARAMS ((Tcl_Interp *)); | |
133 | ||
134 | /* | |
135 | * Private functions defined in this file | |
136 | */ | |
137 | ||
138 | /* Entries into this file */ | |
139 | ||
140 | static int gdb_variable_command PARAMS ((ClientData, Tcl_Interp *, int, | |
141 | Tcl_Obj *CONST[])); | |
142 | ||
143 | static int variable_create PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[])); | |
144 | ||
145 | static void variable_delete PARAMS ((Tcl_Interp *, gdb_variable *)); | |
146 | ||
147 | static void variable_debug PARAMS ((gdb_variable *)); | |
148 | ||
149 | static int variable_obj_command PARAMS ((ClientData, Tcl_Interp *, int, | |
150 | Tcl_Obj *CONST[])); | |
151 | static Tcl_Obj *variable_children PARAMS ((Tcl_Interp *, gdb_variable *)); | |
152 | ||
153 | static enum value_changed variable_value_changed PARAMS ((gdb_variable *)); | |
154 | ||
155 | static int variable_format PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[], | |
156 | gdb_variable *)); | |
157 | ||
158 | static int variable_type PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[], | |
159 | gdb_variable *)); | |
160 | ||
161 | static int variable_value PARAMS ((Tcl_Interp *, int, Tcl_Obj *CONST[], | |
162 | gdb_variable *)); | |
163 | ||
164 | static int variable_editable PARAMS ((gdb_variable *)); | |
165 | ||
166 | /* Helper functions for the above functions. */ | |
167 | ||
168 | static gdb_variable *create_variable PARAMS ((char *, char *, CORE_ADDR)); | |
169 | ||
170 | static void delete_children PARAMS ((Tcl_Interp *, gdb_variable *, int)); | |
171 | ||
172 | static void install_variable PARAMS ((Tcl_Interp *, char *, gdb_variable *)); | |
173 | ||
174 | static void uninstall_variable PARAMS ((Tcl_Interp *, gdb_variable *)); | |
175 | ||
176 | static gdb_variable *child_exists PARAMS ((gdb_variable *, char *)); | |
177 | ||
178 | static gdb_variable *create_child PARAMS ((Tcl_Interp *, gdb_variable *, | |
179 | char *, int)); | |
180 | static char *name_of_child PARAMS ((gdb_variable *, int)); | |
181 | ||
182 | static int number_of_children PARAMS ((gdb_variable *)); | |
183 | ||
184 | static enum display_format variable_default_display PARAMS ((gdb_variable *)); | |
185 | ||
186 | static void save_child_in_parent PARAMS ((gdb_variable *, gdb_variable *)); | |
187 | ||
188 | static void remove_child_from_parent PARAMS ((gdb_variable *, gdb_variable *)); | |
189 | ||
190 | static struct type *get_type PARAMS ((value_ptr)); | |
191 | ||
192 | static struct type *get_target_type PARAMS ((struct type *)); | |
193 | ||
194 | static Tcl_Obj *get_call_output PARAMS ((void)); | |
195 | ||
196 | static void clear_gdb_output PARAMS ((void)); | |
197 | ||
198 | static int call_gdb_type_print PARAMS ((value_ptr)); | |
199 | ||
200 | static int call_gdb_val_print PARAMS ((value_ptr, int)); | |
201 | ||
31262a40 | 202 | static void variable_fputs PARAMS ((const char *, GDB_FILE *)); |
c98fe0c1 | 203 | |
31262a40 | 204 | static void null_fputs PARAMS ((const char *, GDB_FILE *)); |
c98fe0c1 JI |
205 | |
206 | static int my_value_equal PARAMS ((gdb_variable *, value_ptr)); | |
207 | ||
208 | #define INIT_VARIABLE(x) { \ | |
209 | (x)->name = NULL; \ | |
210 | (x)->real_name = NULL; \ | |
211 | (x)->obj_name = NULL; \ | |
212 | (x)->exp = NULL; \ | |
213 | (x)->valid_block = NULL; \ | |
214 | (x)->frame = (CORE_ADDR) 0; \ | |
215 | (x)->value = NULL; \ | |
216 | (x)->error = 0; \ | |
217 | (x)->num_children = 0; \ | |
218 | (x)->parent = NULL; \ | |
219 | (x)->children = NULL; \ | |
220 | (x)->format = FORMAT_NATURAL; \ | |
221 | } | |
222 | ||
223 | #if defined(FREEIF) | |
224 | # undef FREEIF | |
225 | #endif | |
226 | #define FREEIF(x) if (x != NULL) free((char *) (x)) | |
227 | ||
228 | /* Initialize the variable code. This function should be called once | |
229 | to install and initialize the variable code into the interpreter. */ | |
230 | int | |
231 | gdb_variable_init (interp) | |
232 | Tcl_Interp *interp; | |
233 | { | |
234 | Tcl_Command result; | |
235 | ||
236 | result = Tcl_CreateObjCommand (interp, "gdb_variable", call_wrapper, | |
237 | (ClientData) gdb_variable_command, NULL); | |
238 | if (result == NULL) | |
239 | return TCL_ERROR; | |
240 | ||
241 | return TCL_OK; | |
242 | } | |
243 | ||
244 | /* This function defines the "gdb_variable" command which is used to | |
245 | create variable objects. Its syntax includes: | |
246 | ||
247 | gdb_variable create | |
248 | gdb_variable create NAME | |
249 | gdb_variable create -expr EXPR | |
250 | gdb_variable create NAME -expr EXPR | |
251 | ||
252 | NAME = name of object to create. If no NAME, then automatically create | |
253 | a name | |
254 | EXPR = the gdb expression for which to create a variable. This will | |
255 | be the most common usage. | |
256 | */ | |
257 | static int | |
258 | gdb_variable_command (clientData, interp, objc, objv) | |
259 | ClientData clientData; | |
260 | Tcl_Interp *interp; | |
261 | int objc; | |
262 | Tcl_Obj *CONST objv[]; | |
263 | { | |
264 | static char *commands[] = { "create", NULL }; | |
265 | enum commands_enum { VARIABLE_CREATE }; | |
266 | int index, result; | |
267 | ||
268 | if (objc < 2) | |
269 | { | |
270 | Tcl_WrongNumArgs (interp, 1, objv, "option ?arg...?"); | |
271 | return TCL_ERROR; | |
272 | } | |
273 | ||
274 | if (Tcl_GetIndexFromObj (interp, objv[1], commands, "options", 0, | |
275 | &index) != TCL_OK) | |
276 | { | |
277 | return TCL_ERROR; | |
278 | } | |
279 | ||
280 | switch ((enum commands_enum) index) | |
281 | { | |
282 | case VARIABLE_CREATE: | |
283 | result = variable_create (interp, objc - 2, objv + 2); | |
284 | break; | |
285 | ||
286 | default: | |
287 | return TCL_ERROR; | |
288 | } | |
289 | ||
290 | return result; | |
291 | } | |
292 | ||
293 | /* This function implements the actual object command for each | |
294 | variable object that is created (and each of its children). | |
295 | ||
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 | |
303 | */ | |
304 | static int | |
305 | variable_obj_command (clientData, interp, objc, objv) | |
306 | ClientData clientData; | |
307 | Tcl_Interp *interp; | |
308 | int objc; | |
309 | Tcl_Obj *CONST objv[]; | |
310 | { | |
311 | enum commands_enum { | |
312 | VARIABLE_DELETE, | |
313 | VARIABLE_VALUE_CHANGED, | |
314 | VARIABLE_NUM_CHILDREN, | |
315 | VARIABLE_CHILDREN, | |
316 | VARIABLE_DEBUG, | |
317 | VARIABLE_FORMAT, | |
318 | VARIABLE_TYPE, | |
319 | VARIABLE_VALUE, | |
320 | VARIABLE_NAME, | |
321 | VARIABLE_EDITABLE | |
322 | }; | |
323 | static char *commands[] = { | |
324 | "delete", | |
325 | "valueChanged", | |
326 | "numChildren", | |
327 | "children", | |
328 | "debug", | |
329 | "format", | |
330 | "type", | |
331 | "value", | |
332 | "name", | |
333 | "editable", | |
334 | NULL | |
335 | }; | |
336 | gdb_variable *var = (gdb_variable *) clientData; | |
337 | int index, result; | |
338 | ||
339 | if (objc < 2) | |
340 | { | |
341 | Tcl_WrongNumArgs (interp, 1, objv, "option ?arg...?"); | |
342 | return TCL_ERROR; | |
343 | } | |
344 | ||
345 | if (Tcl_GetIndexFromObj (interp, objv[1], commands, "options", 0, | |
346 | &index) != TCL_OK) | |
347 | return TCL_ERROR; | |
348 | ||
349 | result = TCL_OK; | |
350 | switch ((enum commands_enum) index) | |
351 | { | |
352 | case VARIABLE_DELETE: | |
353 | if (objc > 2) | |
354 | { | |
355 | int len; | |
356 | char *s = Tcl_GetStringFromObj (objv[2], &len); | |
357 | if (*s == 'c' && strncmp (s, "children", len) == 0) | |
358 | { | |
359 | delete_children (interp, var, 1); | |
360 | break; | |
361 | } | |
362 | } | |
363 | variable_delete (interp, var); | |
364 | break; | |
365 | ||
366 | case VARIABLE_VALUE_CHANGED: | |
367 | { | |
368 | enum value_changed vc = variable_value_changed (var); | |
369 | Tcl_SetObjResult (interp, Tcl_NewStringObj (value_changed_string[vc], -1)); | |
370 | } | |
371 | break; | |
372 | ||
373 | case VARIABLE_NUM_CHILDREN: | |
374 | Tcl_SetObjResult (interp, Tcl_NewIntObj (var->num_children)); | |
375 | break; | |
376 | ||
377 | case VARIABLE_CHILDREN: | |
378 | { | |
379 | Tcl_Obj *children = variable_children (interp, var); | |
380 | Tcl_SetObjResult (interp, children); | |
381 | } | |
382 | break; | |
383 | ||
384 | case VARIABLE_DEBUG: | |
385 | variable_debug (var); | |
386 | break; | |
387 | ||
388 | case VARIABLE_FORMAT: | |
389 | result = variable_format (interp, objc, objv, var); | |
390 | break; | |
391 | ||
392 | case VARIABLE_TYPE: | |
393 | result = variable_type (interp, objc, objv, var); | |
394 | break; | |
395 | ||
396 | case VARIABLE_VALUE: | |
397 | result = variable_value (interp, objc, objv, var); | |
398 | break; | |
399 | ||
400 | case VARIABLE_NAME: | |
401 | Tcl_SetObjResult (interp, Tcl_NewStringObj (var->name, -1)); | |
402 | break; | |
403 | ||
404 | case VARIABLE_EDITABLE: | |
405 | Tcl_SetObjResult (interp, Tcl_NewIntObj (variable_editable (var))); | |
406 | break; | |
407 | ||
408 | default: | |
409 | return TCL_ERROR; | |
410 | } | |
411 | ||
412 | return result; | |
413 | } | |
414 | ||
415 | /* | |
416 | * Variable object construction/destruction | |
417 | */ | |
418 | ||
419 | /* This function is responsible for processing the user's specifications | |
420 | and constructing a variable object. */ | |
421 | static int | |
422 | variable_create (interp, objc, objv) | |
423 | Tcl_Interp *interp; | |
424 | int objc; | |
425 | Tcl_Obj *CONST objv[]; | |
426 | { | |
427 | enum create_opts { CREATE_EXPR, CREATE_PC }; | |
428 | static char *create_options[] = { "-expr", "-pc", NULL }; | |
429 | gdb_variable *var; | |
430 | char *name; | |
431 | char obj_name[31]; | |
432 | int index; | |
433 | static int id = 0; | |
434 | CORE_ADDR pc = (CORE_ADDR) -1; | |
435 | ||
436 | /* REMINDER: This command may be invoked in the following ways: | |
437 | gdb_variable create | |
438 | gdb_variable create NAME | |
439 | gdb_variable create -expr EXPR | |
440 | gdb_variable create NAME -expr EXPR | |
441 | ||
442 | NAME = name of object to create. If no NAME, then automatically create | |
443 | a name | |
444 | EXPR = the gdb expression for which to create a variable. This will | |
445 | be the most common usage. | |
446 | */ | |
447 | name = NULL; | |
448 | if (objc) | |
449 | name = Tcl_GetStringFromObj (objv[0], NULL); | |
450 | if (name == NULL || *name == '-') | |
451 | { | |
452 | /* generate a name for this object */ | |
453 | id++; | |
454 | sprintf (obj_name, "var%d", id); | |
455 | } | |
456 | else | |
457 | { | |
458 | /* specified name for object */ | |
459 | strncpy (obj_name, name, 30); | |
460 | objv++; | |
461 | objc--; | |
462 | } | |
463 | ||
464 | /* Run through all the possible options for this command */ | |
465 | name = NULL; | |
466 | while (objc > 0) | |
467 | { | |
468 | if (Tcl_GetIndexFromObj (interp, objv[0], create_options, "options", | |
469 | 0, &index) != TCL_OK) | |
470 | { | |
471 | result_ptr->flags |= GDBTK_IN_TCL_RESULT; | |
472 | return TCL_ERROR; | |
473 | } | |
474 | ||
475 | switch ((enum create_opts) index) | |
476 | { | |
477 | case CREATE_EXPR: | |
478 | name = Tcl_GetStringFromObj (objv[1], NULL); | |
479 | objc--; | |
480 | objv++; | |
481 | break; | |
482 | ||
483 | case CREATE_PC: | |
484 | { | |
485 | char *str; | |
486 | str = Tcl_GetStringFromObj (objv[1], NULL); | |
487 | pc = parse_and_eval_address (str); | |
488 | objc--; | |
489 | objv++; | |
490 | } | |
491 | break; | |
492 | ||
493 | default: | |
494 | break; | |
495 | } | |
496 | ||
497 | objc--; | |
498 | objv++; | |
499 | } | |
500 | ||
501 | /* Create the variable */ | |
502 | var = create_variable (name, name, pc); | |
503 | ||
504 | if (var != NULL) | |
505 | { | |
506 | /* Install a command into the interpreter that represents this | |
507 | object */ | |
508 | install_variable (interp, obj_name, var); | |
509 | Tcl_SetObjResult (interp, Tcl_NewStringObj (obj_name, -1)); | |
510 | result_ptr->flags |= GDBTK_IN_TCL_RESULT; | |
511 | ||
512 | return TCL_OK; | |
513 | } | |
514 | ||
515 | return TCL_ERROR; | |
516 | } | |
517 | ||
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) | |
523 | char *name; | |
524 | char *real_name; | |
525 | CORE_ADDR pc; | |
526 | { | |
527 | gdb_variable *var; | |
528 | value_ptr mark; | |
529 | struct frame_info *fi, *old_fi; | |
530 | struct block *block; | |
31262a40 | 531 | void (*old_fputs) PARAMS ((const char *, GDB_FILE *)); |
c98fe0c1 JI |
532 | gdb_result r; |
533 | ||
534 | var = (gdb_variable *) xmalloc (sizeof (gdb_variable)); | |
535 | INIT_VARIABLE (var); | |
536 | ||
537 | if (name != NULL) | |
538 | { | |
539 | char *p; | |
540 | ||
541 | /* Parse and evaluate the expression, filling in as much | |
542 | of the variable's data as possible */ | |
543 | ||
544 | /* Allow creator to specify context of variable */ | |
545 | if (pc == (CORE_ADDR) -1) | |
546 | block = 0; | |
547 | else | |
548 | { | |
549 | r = GDB_block_for_pc (pc, &block); | |
550 | if (r != GDB_OK) | |
551 | block = 0; | |
552 | } | |
553 | ||
554 | p = real_name; | |
555 | innermost_block = NULL; | |
556 | r = GDB_parse_exp_1 (&p, block, 0, &(var->exp)); | |
557 | if (r != GDB_OK) | |
558 | { | |
559 | FREEIF ((char *) var); | |
560 | return NULL; | |
561 | } | |
562 | ||
563 | /* Don't allow variables to be created for types. */ | |
564 | if (var->exp->elts[0].opcode == OP_TYPE) | |
565 | { | |
566 | free_current_contents ((char **) &(var->exp)); | |
567 | FREEIF (var); | |
568 | printf_unfiltered ("Attempt to use a type name as an expression."); | |
569 | return NULL; | |
570 | } | |
571 | ||
572 | var->valid_block = innermost_block; | |
573 | var->name = savestring (name, strlen (name)); | |
574 | var->real_name = savestring (real_name, strlen (real_name)); | |
575 | ||
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 | |
578 | show them). */ | |
579 | old_fputs = fputs_unfiltered_hook; | |
580 | fputs_unfiltered_hook = null_fputs; | |
581 | ||
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); | |
587 | if (r != GDB_OK) | |
588 | fi = NULL; | |
589 | if (fi) | |
590 | var->frame = FRAME_FP (fi); | |
591 | old_fi = selected_frame; | |
592 | GDB_select_frame (fi, -1); | |
593 | ||
594 | mark = value_mark (); | |
595 | if (GDB_evaluate_expression (var->exp, &var->value) == GDB_OK) | |
596 | { | |
597 | release_value (var->value); | |
598 | if (VALUE_LAZY (var->value)) | |
599 | { | |
600 | if (GDB_value_fetch_lazy (var->value) != GDB_OK) | |
601 | var->error = 1; | |
602 | else | |
603 | var->error = 0; | |
604 | } | |
605 | } | |
606 | else | |
607 | var->error = 1; | |
608 | value_free_to_mark (mark); | |
609 | ||
610 | /* Reset the selected frame */ | |
611 | GDB_select_frame (old_fi, -1); | |
612 | ||
613 | /* Restore the output hook to normal */ | |
614 | fputs_unfiltered_hook = old_fputs; | |
615 | ||
616 | var->num_children = number_of_children (var); | |
617 | var->format = variable_default_display (var); | |
618 | } | |
619 | ||
620 | return var; | |
621 | } | |
622 | ||
623 | /* Install the given variable VAR into the tcl interpreter with | |
624 | the object name NAME. */ | |
625 | static void | |
626 | install_variable (interp, name, var) | |
627 | Tcl_Interp *interp; | |
628 | char *name; | |
629 | gdb_variable *var; | |
630 | { | |
631 | var->obj_name = savestring (name, strlen (name)); | |
632 | Tcl_CreateObjCommand (interp, name, variable_obj_command, | |
633 | (ClientData) var, NULL); | |
634 | } | |
635 | ||
636 | /* Unistall the object VAR in the tcl interpreter. */ | |
637 | static void | |
638 | uninstall_variable (interp, var) | |
639 | Tcl_Interp *interp; | |
640 | gdb_variable *var; | |
641 | { | |
642 | Tcl_DeleteCommand (interp, var->obj_name); | |
643 | } | |
644 | ||
645 | /* Delete the variable object VAR and its children */ | |
646 | static void | |
647 | variable_delete (interp, var) | |
648 | Tcl_Interp *interp; | |
649 | gdb_variable *var; | |
650 | { | |
651 | /* Delete any children of this variable, too. */ | |
652 | delete_children (interp, var, 0); | |
653 | ||
654 | /* If this variable has a parent, remove it from its parent's list */ | |
655 | if (var->parent != NULL) | |
656 | { | |
657 | remove_child_from_parent (var->parent, var); | |
658 | } | |
659 | ||
660 | uninstall_variable (interp, var); | |
661 | ||
662 | /* Free memory associated with this variable */ | |
663 | FREEIF (var->name); | |
664 | FREEIF (var->real_name); | |
665 | FREEIF (var->obj_name); | |
666 | if (var->exp != NULL) | |
667 | free_current_contents ((char **) &var->exp); | |
668 | FREEIF (var); | |
669 | } | |
670 | ||
671 | /* Silly debugging info */ | |
672 | static void | |
673 | variable_debug (var) | |
674 | gdb_variable *var; | |
675 | { | |
676 | Tcl_Obj *str; | |
677 | ||
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); | |
682 | } | |
683 | ||
684 | /* | |
685 | * Child construction/destruction | |
686 | */ | |
687 | ||
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. */ | |
693 | static void | |
694 | delete_children (interp, var, notify) | |
695 | Tcl_Interp *interp; | |
696 | gdb_variable *var; | |
697 | int notify; | |
698 | { | |
699 | struct variable_child *vc; | |
700 | struct variable_child *next; | |
701 | ||
702 | for (vc = var->children; vc != NULL; vc = next) | |
703 | { | |
704 | if (!notify) | |
705 | vc->child->parent = NULL; | |
706 | variable_delete (interp, vc->child); | |
707 | next = vc->next; | |
708 | free (vc); | |
709 | } | |
710 | } | |
711 | ||
712 | /* Return the number of children for a given variable. | |
713 | ||
714 | This can get a little complicated, since we would like to make | |
715 | certain assumptions about certain types of variables. | |
716 | ||
717 | - struct/union *: dereference first | |
718 | - (*)(): do not allow derefencing | |
719 | - arrays: | |
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 | |
725 | */ | |
726 | static int | |
727 | number_of_children (var) | |
728 | gdb_variable *var; | |
729 | { | |
730 | struct type *type; | |
731 | struct type *target; | |
732 | int children; | |
733 | ||
734 | if (var->value != NULL) | |
735 | { | |
736 | type = get_type (var->value); | |
737 | target = get_target_type (type); | |
738 | children = 0; | |
739 | ||
740 | switch (TYPE_CODE (type)) | |
741 | { | |
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); | |
746 | else | |
747 | children = -1; | |
748 | break; | |
749 | ||
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; | |
756 | else | |
757 | children = TYPE_NFIELDS (type); | |
758 | break; | |
759 | ||
760 | case TYPE_CODE_PTR: | |
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)) | |
765 | { | |
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; | |
772 | else | |
773 | children = TYPE_NFIELDS (target); | |
774 | break; | |
775 | ||
776 | case TYPE_CODE_FUNC: | |
777 | children = 0; | |
778 | break; | |
779 | ||
780 | default: | |
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"))) | |
785 | children = 0; | |
786 | else | |
787 | children = 1; | |
788 | } | |
789 | break; | |
790 | ||
791 | default: | |
792 | break; | |
793 | } | |
794 | } | |
795 | else | |
796 | { | |
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. */ | |
801 | children = 0; | |
802 | } | |
803 | ||
804 | return children; | |
805 | } | |
806 | ||
807 | /* Return a list of all the children of VAR, creating them if necessary. */ | |
808 | static Tcl_Obj * | |
809 | variable_children (interp, var) | |
810 | Tcl_Interp *interp; | |
811 | gdb_variable *var; | |
812 | { | |
813 | Tcl_Obj *list; | |
814 | gdb_variable *child; | |
815 | char *name; | |
816 | int i; | |
817 | ||
818 | list = Tcl_NewListObj (0, NULL); | |
819 | for (i = 0; i < var->num_children; i++) | |
820 | { | |
821 | /* check if child exists */ | |
822 | name = name_of_child (var, i); | |
823 | child = child_exists (var, name); | |
824 | if (child == NULL) | |
825 | { | |
826 | child = create_child (interp, var, name, i); | |
827 | ||
828 | /* name_of_child returns a malloc'd string */ | |
829 | free (name); | |
830 | } | |
831 | Tcl_ListObjAppendElement (NULL, list, Tcl_NewStringObj (child->obj_name, -1)); | |
832 | } | |
833 | ||
834 | return list; | |
835 | } | |
836 | ||
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 */ | |
843 | { | |
844 | struct variable_child *vc; | |
845 | ||
846 | for (vc = var->children; vc != NULL; vc = vc->next) | |
847 | { | |
848 | if (STREQ (vc->child->name, name)) | |
849 | return vc->child; | |
850 | } | |
851 | ||
852 | return NULL; | |
853 | } | |
854 | ||
855 | /* Create and install a child of the parent of the given name */ | |
856 | static gdb_variable * | |
857 | create_child (interp, parent, name, index) | |
858 | Tcl_Interp *interp; | |
859 | gdb_variable *parent; | |
860 | char *name; | |
861 | int index; | |
862 | { | |
863 | struct type *type; | |
864 | struct type *target; | |
865 | gdb_variable *child; | |
866 | char separator[10], prefix[2048], suffix[20]; | |
867 | char *childs_name; | |
868 | char *save_name; | |
869 | int deref = 0; | |
870 | int len; | |
871 | ||
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 | |
874 | the array. */ | |
875 | ||
876 | separator[0] = '\0'; | |
877 | prefix[0] = '\0'; | |
878 | suffix[0] = '\0';; | |
879 | save_name = name; | |
880 | ||
881 | /* This code must contain a lot of the logic for children based on the parent's | |
882 | type. */ | |
883 | type = get_type (parent->value); | |
884 | target = get_target_type (type); | |
885 | ||
886 | switch (TYPE_CODE (type)) | |
887 | { | |
888 | case TYPE_CODE_ARRAY: | |
889 | sprintf (suffix, "[%s]", name); | |
890 | name = ""; | |
891 | break; | |
892 | ||
893 | case TYPE_CODE_STRUCT: | |
894 | case TYPE_CODE_UNION: | |
895 | if (index < TYPE_N_BASECLASSES (type)) | |
896 | { | |
897 | strcpy (prefix, "(("); | |
898 | strcat (prefix, name); | |
899 | strcat (prefix, ")"); | |
900 | strcpy (suffix, ") "); | |
901 | name = ""; | |
902 | } | |
903 | else | |
904 | strcpy (separator, "."); | |
905 | break; | |
906 | ||
907 | case TYPE_CODE_PTR: | |
908 | switch (TYPE_CODE (target)) | |
909 | { | |
910 | case TYPE_CODE_STRUCT: | |
911 | case TYPE_CODE_UNION: | |
912 | if (index < TYPE_N_BASECLASSES (target)) | |
913 | { | |
914 | strcpy (prefix, "(*("); | |
915 | strcat (prefix, name); | |
916 | strcat (prefix, " *)"); | |
917 | strcpy (suffix, ")"); | |
918 | name = ""; | |
919 | } | |
920 | else | |
921 | strcpy (separator, "->"); | |
922 | break; | |
923 | ||
924 | default: | |
925 | deref = 1; | |
926 | break; | |
927 | } | |
928 | ||
929 | default: | |
930 | break; | |
931 | } | |
932 | ||
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); | |
940 | if (deref) | |
941 | len += 3; | |
942 | childs_name = (char *) xmalloc ((len + 1) * sizeof (char)); | |
943 | if (deref) | |
944 | { | |
945 | strcpy (childs_name, "(*"); | |
946 | strcat (childs_name, parent->real_name); | |
947 | strcat (childs_name, suffix); | |
948 | strcat (childs_name, ")"); | |
949 | } | |
950 | else | |
951 | { | |
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); | |
957 | } | |
958 | ||
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; | |
962 | free (childs_name); | |
963 | childs_name = (char *) xmalloc ((strlen (parent->obj_name) + strlen (save_name) + 2) | |
964 | * sizeof (char)); | |
965 | sprintf (childs_name, "%s.%s", parent->obj_name, save_name); | |
966 | install_variable (interp, childs_name, child); | |
967 | free (childs_name); | |
968 | ||
969 | /* Save a pointer to this child in the parent */ | |
970 | save_child_in_parent (parent, child); | |
971 | ||
972 | return child; | |
973 | } | |
974 | ||
975 | /* Save CHILD in the PARENT's data. */ | |
976 | static void | |
977 | save_child_in_parent (parent, child) | |
978 | gdb_variable *parent; | |
979 | gdb_variable *child; | |
980 | { | |
981 | struct variable_child *vc; | |
982 | ||
983 | /* Insert the child at the top */ | |
984 | vc = parent->children; | |
985 | parent->children = | |
986 | (struct variable_child *) xmalloc (sizeof (struct variable_child)); | |
987 | ||
988 | parent->children->next = vc; | |
989 | parent->children->child = child; | |
990 | } | |
991 | ||
992 | /* Remove the CHILD from the PARENT's list of children. */ | |
993 | static void | |
994 | remove_child_from_parent (parent, child) | |
995 | gdb_variable *parent; | |
996 | gdb_variable *child; | |
997 | { | |
998 | struct variable_child *vc, *prev; | |
999 | ||
1000 | /* Find the child in the parent's list */ | |
1001 | prev = NULL; | |
1002 | for (vc = parent->children; vc != NULL; ) | |
1003 | { | |
1004 | if (vc->child == child) | |
1005 | break; | |
1006 | prev = vc; | |
1007 | vc = vc->next; | |
1008 | } | |
1009 | ||
1010 | if (prev == NULL) | |
1011 | parent->children = vc->next; | |
1012 | else | |
1013 | prev->next = vc->next; | |
1014 | ||
1015 | } | |
1016 | ||
1017 | /* What is the name of the INDEX'th child of VAR? */ | |
1018 | static char * | |
1019 | name_of_child (var, index) | |
1020 | gdb_variable *var; | |
1021 | int index; | |
1022 | { | |
1023 | struct type *type; | |
1024 | struct type *target; | |
1025 | char *name; | |
1026 | char *string; | |
1027 | ||
1028 | type = get_type (var->value); | |
1029 | target = get_target_type (type); | |
1030 | ||
1031 | switch (TYPE_CODE (type)) | |
1032 | { | |
1033 | case TYPE_CODE_ARRAY: | |
1034 | { | |
1035 | /* We never get here unless var->num_children is greater than 0... */ | |
1036 | int len = 1; | |
1037 | while ((int) pow ((double) 10, (double) len) < index) | |
1038 | len++; | |
1039 | name = (char *) xmalloc (1 + len * sizeof (char)); | |
1040 | sprintf (name, "%d", index); | |
1041 | } | |
1042 | break; | |
1043 | ||
1044 | case TYPE_CODE_STRUCT: | |
1045 | case TYPE_CODE_UNION: | |
1046 | string = TYPE_FIELD_NAME (type, index); | |
1047 | name = savestring (string, strlen (string)); | |
1048 | break; | |
1049 | ||
1050 | case TYPE_CODE_PTR: | |
1051 | switch (TYPE_CODE (target)) | |
1052 | { | |
1053 | case TYPE_CODE_STRUCT: | |
1054 | case TYPE_CODE_UNION: | |
1055 | string = TYPE_FIELD_NAME (target, index); | |
1056 | name = savestring (string, strlen (string)); | |
1057 | break; | |
1058 | ||
1059 | default: | |
1060 | name = (char *) xmalloc ((strlen (var->name) + 2) * sizeof (char)); | |
1061 | sprintf (name, "*%s", var->name); | |
1062 | break; | |
1063 | } | |
1064 | } | |
1065 | ||
1066 | return name; | |
1067 | } | |
1068 | ||
1069 | /* Has the value of this object changed since the last time we looked? | |
1070 | ||
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. | |
1078 | */ | |
1079 | static enum value_changed | |
1080 | variable_value_changed (var) | |
1081 | gdb_variable *var; | |
1082 | { | |
1083 | value_ptr mark, new_val; | |
1084 | struct frame_info *fi, *old_fi; | |
1085 | int within_scope; | |
1086 | enum value_changed result; | |
1087 | gdb_result r; | |
1088 | ||
1089 | /* Save the selected stack frame, since we will need to change it | |
1090 | in order to evaluate expressions. */ | |
1091 | old_fi = selected_frame; | |
1092 | ||
1093 | /* Determine whether the variable is still around. */ | |
1094 | if (var->valid_block == NULL) | |
1095 | within_scope = 1; | |
1096 | else | |
1097 | { | |
1098 | GDB_reinit_frame_cache (); | |
1099 | r = GDB_find_frame_addr_in_frame_chain (var->frame, &fi); | |
1100 | if (r != GDB_OK) | |
1101 | fi = NULL; | |
1102 | within_scope = fi != NULL; | |
1103 | /* FIXME: GDB_select_frame could fail */ | |
1104 | if (within_scope) | |
1105 | GDB_select_frame (fi, -1); | |
1106 | } | |
1107 | ||
1108 | result = VALUE_OUT_OF_SCOPE; | |
1109 | if (within_scope) | |
1110 | { | |
1111 | struct type *type = get_type (var->value); | |
1112 | ||
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; | |
1118 | else | |
1119 | { | |
1120 | mark = value_mark (); | |
1121 | if (GDB_evaluate_expression (var->exp, &new_val) == GDB_OK) | |
1122 | { | |
1123 | if (!my_value_equal (var, new_val)) | |
1124 | { | |
1125 | /* value changed */ | |
1126 | release_value (new_val); | |
1127 | if (var->value == NULL) | |
1128 | { | |
1129 | /* This can happen if there was an error | |
1130 | evaluating the expression (like deref NULL) */ | |
1131 | var->num_children = number_of_children (var); | |
1132 | } | |
1133 | value_free (var->value); | |
1134 | var->value = new_val; | |
1135 | result = VALUE_CHANGED; | |
1136 | } | |
1137 | else | |
1138 | result = VALUE_UNCHANGED; | |
1139 | } | |
1140 | else | |
1141 | { | |
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; | |
1147 | else | |
1148 | { | |
1149 | var->value = NULL; | |
1150 | var->error = 1; | |
1151 | result = VALUE_CHANGED; | |
1152 | } | |
1153 | } | |
1154 | ||
1155 | value_free_to_mark (mark); | |
1156 | } | |
1157 | } | |
1158 | ||
1159 | /* Restore selected frame */ | |
1160 | GDB_select_frame (old_fi, -1); | |
1161 | ||
1162 | return result; | |
1163 | } | |
1164 | ||
1165 | static int | |
1166 | variable_format (interp, objc, objv, var) | |
1167 | Tcl_Interp *interp; | |
1168 | int objc; | |
1169 | Tcl_Obj *CONST objv[]; | |
1170 | gdb_variable *var; | |
1171 | { | |
1172 | ||
1173 | if (objc > 2) | |
1174 | { | |
1175 | /* Set the format of VAR to given format */ | |
1176 | int len; | |
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; | |
1188 | else | |
1189 | { | |
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\"", | |
1194 | NULL); | |
1195 | Tcl_SetObjResult (interp, obj); | |
1196 | return TCL_ERROR; | |
1197 | } | |
1198 | } | |
1199 | else | |
1200 | { | |
1201 | /* Report the current format */ | |
1202 | Tcl_Obj *fmt; | |
1203 | ||
1204 | fmt = Tcl_NewStringObj (format_string [(int) var->format], -1); | |
1205 | Tcl_SetObjResult (interp, fmt); | |
1206 | } | |
1207 | ||
1208 | return TCL_OK; | |
1209 | } | |
1210 | ||
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) | |
1215 | gdb_variable *var; | |
1216 | { | |
1217 | return FORMAT_NATURAL; | |
1218 | } | |
1219 | ||
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. */ | |
1222 | static int | |
1223 | variable_type (interp, objc, objv, var) | |
1224 | Tcl_Interp *interp; | |
1225 | int objc; | |
1226 | Tcl_Obj *CONST objv[]; | |
1227 | gdb_variable *var; | |
1228 | { | |
1229 | int result; | |
1230 | value_ptr val; | |
1231 | char *first, *last, *string; | |
1232 | Tcl_RegExp regexp; | |
1233 | gdb_result r; | |
1234 | ||
1235 | if (var->value != NULL) | |
1236 | val = var->value; | |
1237 | else | |
1238 | { | |
1239 | r = GDB_evaluate_type (var->exp, &val); | |
1240 | if (r != GDB_OK) | |
1241 | return TCL_ERROR; | |
1242 | } | |
1243 | ||
1244 | result = call_gdb_type_print (val); | |
1245 | if (result == TCL_OK) | |
1246 | { | |
1247 | string = strdup (Tcl_GetStringFromObj (get_call_output (), NULL)); | |
1248 | first = string; | |
1249 | ||
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)) | |
1254 | { | |
1255 | /* We have an anonymous struct/union/class/enum */ | |
1256 | Tcl_RegExpRange (regexp, 0, &first, &last); | |
1257 | if (*(first - 1) == ' ') | |
1258 | first--; | |
1259 | *first = '\0'; | |
1260 | } | |
1261 | ||
1262 | Tcl_SetObjResult (interp, Tcl_NewStringObj (string, -1)); | |
1263 | FREEIF (string); | |
1264 | return TCL_OK; | |
1265 | } | |
1266 | ||
1267 | Tcl_SetObjResult (interp, get_call_output ()); | |
1268 | return result; | |
1269 | } | |
1270 | ||
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. */ | |
1273 | static int | |
1274 | variable_value (interp, objc, objv, var) | |
1275 | Tcl_Interp *interp; | |
1276 | int objc; | |
1277 | Tcl_Obj *CONST objv[]; | |
1278 | gdb_variable *var; | |
1279 | { | |
1280 | int result; | |
1281 | struct type *type; | |
1282 | value_ptr val; | |
1283 | Tcl_Obj *str; | |
1284 | gdb_result r; | |
1285 | int real_addressprint; | |
1286 | ||
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 | |
1289 | for this -- ugh! */ | |
1290 | if (objc > 2) | |
1291 | { | |
1292 | /* Does this cover all the bases? */ | |
1293 | struct expression *exp; | |
1294 | value_ptr value; | |
1295 | int saved_input_radix = input_radix; | |
1296 | ||
1297 | if (VALUE_LVAL (var->value) != not_lval && var->value->modifiable) | |
1298 | { | |
1299 | char *s; | |
1300 | ||
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); | |
1304 | if (r != GDB_OK) | |
1305 | return TCL_ERROR; | |
1306 | if (GDB_evaluate_expression (exp, &value) != GDB_OK) | |
1307 | return TCL_ERROR; | |
1308 | ||
1309 | val = value_assign (var->value, value); | |
1310 | value_free (var->value); | |
1311 | release_value (val); | |
1312 | var->value = val; | |
1313 | input_radix = saved_input_radix; | |
1314 | } | |
1315 | ||
1316 | return TCL_OK; | |
1317 | } | |
1318 | ||
1319 | if (var->value != NULL) | |
1320 | val = var->value; | |
1321 | else | |
1322 | { | |
1323 | /* This can happen if we attempt to get the value of a struct | |
1324 | member when the parent is an invalid pointer. | |
1325 | ||
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)); | |
1329 | return TCL_ERROR; | |
1330 | } | |
1331 | ||
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; | |
1336 | ||
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)) | |
1341 | { | |
1342 | case TYPE_CODE_STRUCT: | |
1343 | case TYPE_CODE_UNION: | |
1344 | str = Tcl_NewStringObj ("{...}", -1); | |
1345 | break; | |
1346 | ||
1347 | case TYPE_CODE_ARRAY: | |
1348 | { | |
1349 | char number[256]; | |
1350 | str = Tcl_NewStringObj (NULL, 0); | |
1351 | sprintf (number, "%d", var->num_children); | |
1352 | Tcl_AppendStringsToObj (str, "[", number, "]", NULL); | |
1353 | } | |
1354 | break; | |
1355 | ||
1356 | case TYPE_CODE_REF: | |
1357 | /* Clear addressprint so that the actual value is printed */ | |
1358 | addressprint = 0; | |
1359 | ||
1360 | /* fall through */ | |
1361 | default: | |
1362 | result = call_gdb_val_print (val, format_code[(int) var->format]); | |
1363 | Tcl_SetObjResult (interp, get_call_output ()); | |
1364 | ||
1365 | /* Restore addressprint */ | |
1366 | addressprint = real_addressprint; | |
1367 | return result; | |
1368 | } | |
1369 | ||
1370 | /* We only get here if we encountered one of the "special types" above */ | |
1371 | ||
1372 | /* Restore addressprint */ | |
1373 | addressprint = real_addressprint; | |
1374 | ||
1375 | Tcl_SetObjResult (interp, str); | |
1376 | return TCL_OK; | |
1377 | } | |
1378 | ||
1379 | /* Is this variable editable? Use the variable's type to make | |
1380 | this determination. */ | |
1381 | static int | |
1382 | variable_editable (var) | |
1383 | gdb_variable *var; | |
1384 | { | |
1385 | struct type *type; | |
1386 | int result; | |
1387 | gdb_result r; | |
1388 | ||
1389 | type = get_type (var->value); | |
1390 | if (type == NULL) | |
1391 | { | |
1392 | value_ptr val; | |
1393 | r = GDB_evaluate_type (var->exp, &val); | |
1394 | if (r != GDB_OK) | |
1395 | return 0; | |
1396 | type = get_type (val); | |
1397 | } | |
1398 | ||
1399 | switch (TYPE_CODE (type)) | |
1400 | { | |
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: | |
1407 | result = 0; | |
1408 | break; | |
1409 | ||
1410 | default: | |
1411 | result = 1; | |
1412 | break; | |
1413 | } | |
1414 | ||
1415 | return result; | |
1416 | } | |
1417 | ||
1418 | /* | |
1419 | * Call stuff. These functions are used to capture the output of gdb commands | |
1420 | * without going through the tcl interpreter. | |
1421 | */ | |
1422 | ||
1423 | /* Retrieve gdb output in the buffer since last call. */ | |
1424 | static Tcl_Obj * | |
1425 | get_call_output () | |
1426 | { | |
1427 | /* Clear the error flags, in case we errored. */ | |
1428 | if (result_ptr != NULL) | |
1429 | result_ptr->flags &= ~GDBTK_ERROR_ONLY; | |
1430 | return fputs_obj; | |
1431 | } | |
1432 | ||
1433 | /* Clear the output of the buffer. */ | |
1434 | static void | |
1435 | clear_gdb_output () | |
1436 | { | |
1437 | if (fputs_obj != NULL) | |
1438 | Tcl_DecrRefCount (fputs_obj); | |
1439 | ||
1440 | fputs_obj = Tcl_NewStringObj (NULL, -1); | |
1441 | Tcl_IncrRefCount (fputs_obj); | |
1442 | } | |
1443 | ||
1444 | /* Call the gdb command "type_print", retaining its output in the buffer. */ | |
1445 | static int | |
1446 | call_gdb_type_print (val) | |
1447 | value_ptr val; | |
1448 | { | |
31262a40 | 1449 | void (*old_hook) PARAMS ((const char *, GDB_FILE *)); |
c98fe0c1 JI |
1450 | int result; |
1451 | ||
1452 | /* Save the old hook and install new hook */ | |
1453 | old_hook = fputs_unfiltered_hook; | |
1454 | fputs_unfiltered_hook = variable_fputs; | |
1455 | ||
1456 | /* Call our command with our args */ | |
1457 | clear_gdb_output (); | |
1458 | ||
1459 | ||
1460 | if (GDB_type_print (val, "", gdb_stdout, -1) == GDB_OK) | |
1461 | result = TCL_OK; | |
1462 | else | |
1463 | result = TCL_ERROR; | |
1464 | ||
1465 | /* Restore fputs hook */ | |
1466 | fputs_unfiltered_hook = old_hook; | |
1467 | ||
1468 | return result; | |
1469 | } | |
1470 | ||
1471 | /* Call the gdb command "val_print", retaining its output in the buffer. */ | |
1472 | static int | |
1473 | call_gdb_val_print (val, format) | |
1474 | value_ptr val; | |
1475 | int format; | |
1476 | { | |
31262a40 | 1477 | void (*old_hook) PARAMS ((const char *, GDB_FILE *)); |
c98fe0c1 JI |
1478 | gdb_result r; |
1479 | int result; | |
1480 | ||
1481 | /* Save the old hook and install new hook */ | |
1482 | old_hook = fputs_unfiltered_hook; | |
1483 | fputs_unfiltered_hook = variable_fputs; | |
1484 | ||
1485 | /* Call our command with our args */ | |
1486 | clear_gdb_output (); | |
1487 | ||
1488 | if (VALUE_LAZY (val)) | |
1489 | { | |
1490 | r = GDB_value_fetch_lazy (val); | |
1491 | if (r != GDB_OK) | |
1492 | { | |
1493 | fputs_unfiltered_hook = old_hook; | |
1494 | return TCL_ERROR; | |
1495 | } | |
1496 | } | |
1497 | r = GDB_val_print (VALUE_TYPE (val), VALUE_CONTENTS_RAW (val), VALUE_ADDRESS (val), | |
1498 | gdb_stdout, format, 1, 0, 0); | |
1499 | if (r == GDB_OK) | |
1500 | result = TCL_OK; | |
1501 | else | |
1502 | result = TCL_ERROR; | |
1503 | ||
1504 | /* Restore fputs hook */ | |
1505 | fputs_unfiltered_hook = old_hook; | |
1506 | ||
1507 | return result; | |
1508 | } | |
1509 | ||
1510 | /* The fputs_unfiltered_hook function used to save the output from one of the | |
1511 | call commands in this file. */ | |
1512 | static void | |
1513 | variable_fputs (text, stream) | |
1514 | const char *text; | |
31262a40 | 1515 | GDB_FILE *stream; |
c98fe0c1 JI |
1516 | { |
1517 | /* Just append everything to the fputs_obj... Issues with stderr/stdout? */ | |
1518 | Tcl_AppendToObj (fputs_obj, (char *) text, -1); | |
1519 | } | |
1520 | ||
1521 | /* Empty handler for the fputs_unfiltered_hook. Set the hook to this function | |
1522 | whenever the output is irrelevent. */ | |
1523 | static void | |
1524 | null_fputs (text, stream) | |
1525 | const char *text; | |
31262a40 | 1526 | GDB_FILE *stream; |
c98fe0c1 JI |
1527 | { |
1528 | return; | |
1529 | } | |
1530 | ||
1531 | /* | |
1532 | * Special wrapper-like stuff to supplement the generic wrappers | |
1533 | */ | |
1534 | ||
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 * | |
1538 | get_type (val) | |
1539 | value_ptr val; | |
1540 | { | |
1541 | struct type *type = NULL; | |
1542 | ||
1543 | if (val != NULL) | |
1544 | { | |
1545 | type = VALUE_TYPE (val); | |
1546 | while (type != NULL && TYPE_CODE (type) == TYPE_CODE_TYPEDEF) | |
1547 | type = TYPE_TARGET_TYPE (type); | |
1548 | } | |
1549 | ||
1550 | return type; | |
1551 | } | |
1552 | ||
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) | |
1557 | struct type *type; | |
1558 | { | |
1559 | if (type != NULL) | |
1560 | { | |
1561 | type = TYPE_TARGET_TYPE (type); | |
1562 | while (type != NULL && TYPE_CODE (type) == TYPE_CODE_TYPEDEF) | |
1563 | type = TYPE_TARGET_TYPE (type); | |
1564 | } | |
1565 | ||
1566 | return type; | |
1567 | } | |
1568 | ||
1569 | /* This function is a special wrap. This call never "fails".*/ | |
1570 | static int | |
1571 | my_value_equal (var, val2) | |
1572 | gdb_variable *var; | |
1573 | value_ptr val2; | |
1574 | { | |
1575 | int err1, err2, r; | |
1576 | ||
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. */ | |
1581 | err1 = var->error; | |
1582 | err2 = 0; | |
1583 | if (VALUE_LAZY (val2) && GDB_value_fetch_lazy (val2) != GDB_OK) | |
1584 | err2 = 1; | |
1585 | ||
1586 | /* Another special case: NULL values. If both are null, say | |
1587 | they're equal. */ | |
1588 | if (var->value == NULL && val2 == NULL) | |
1589 | return 1; | |
1590 | else if (var->value == NULL || val2 == NULL) | |
1591 | return 0; | |
1592 | ||
1593 | if (GDB_value_equal (var->value, val2, &r) != GDB_OK) | |
1594 | { | |
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. */ | |
1600 | if (err1 == err2) | |
1601 | { | |
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?? */ | |
1606 | return 1; | |
1607 | } | |
1608 | else | |
1609 | { | |
1610 | /* err2 replaces var->error since this new value | |
1611 | WILL replace the old one. */ | |
1612 | var->error = err2; | |
1613 | return 0; | |
1614 | } | |
1615 | } | |
1616 | ||
1617 | return r; | |
1618 | } | |
1619 | \f | |
1620 | /* Local variables: */ | |
1621 | /* change-log-default-name: "ChangeLog-gdbtk" */ | |
1622 | /* End: */ |