OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtk/] [generic/] [gdbtk-varobj.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/* Variable user interface layer 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
 
23
#include "varobj.h"
24
 
25
#include <tcl.h>
26
#include "gdbtk.h"
27
#include "gdbtk-cmds.h"
28
 
29
/*
30
 * Public functions defined in this file
31
 */
32
 
33
int gdb_variable_init (Tcl_Interp *);
34
 
35
/*
36
 * Private functions defined in this file
37
 */
38
 
39
/* Entries into this file */
40
 
41
static int gdb_variable_command (ClientData, Tcl_Interp *, int,
42
                                 Tcl_Obj * CONST[]);
43
 
44
static int variable_obj_command (ClientData, Tcl_Interp *, int,
45
                                 Tcl_Obj * CONST[]);
46
 
47
/* Variable object subcommands */
48
 
49
static int variable_create (Tcl_Interp *, int, Tcl_Obj * CONST[]);
50
 
51
static void variable_delete (Tcl_Interp *, struct varobj *, int);
52
 
53
static Tcl_Obj *variable_children (Tcl_Interp *, struct varobj *);
54
 
55
static int variable_format (Tcl_Interp *, int, Tcl_Obj * CONST[],
56
                            struct varobj *);
57
 
58
static int variable_type (Tcl_Interp *, int, Tcl_Obj * CONST[],
59
                          struct varobj *);
60
 
61
static int variable_value (Tcl_Interp *, int, Tcl_Obj * CONST[],
62
                           struct varobj *);
63
 
64
static Tcl_Obj *variable_update (Tcl_Interp * interp, struct varobj *var);
65
 
66
/* Helper functions for the above subcommands. */
67
 
68
static void install_variable (Tcl_Interp *, char *, struct varobj *);
69
 
70
static void uninstall_variable (Tcl_Interp *, char *);
71
 
72
/* String representations of gdb's format codes */
73
char *format_string[] =
74
{"natural", "binary", "decimal", "hexadecimal", "octal"};
75
 
76
#if defined(FREEIF)
77
#undef FREEIF
78
#endif
79
#define FREEIF(x) if (x != NULL) free((char *) (x))
80
 
81
/* Initialize the variable code. This function should be called once
82
   to install and initialize the variable code into the interpreter. */
83
int
84
gdb_variable_init (interp)
85
     Tcl_Interp *interp;
86
{
87
  Tcl_Command result;
88
  static int initialized = 0;
89
 
90
  if (!initialized)
91
    {
92
      result = Tcl_CreateObjCommand (interp, "gdb_variable", gdbtk_call_wrapper,
93
                                   (ClientData) gdb_variable_command, NULL);
94
      if (result == NULL)
95
        return TCL_ERROR;
96
 
97
      initialized = 1;
98
    }
99
 
100
  return TCL_OK;
101
}
102
 
103
/* This function defines the "gdb_variable" command which is used to
104
   create variable objects. Its syntax includes:
105
 
106
   gdb_variable create
107
   gdb_variable create NAME
108
   gdb_variable create -expr EXPR
109
   gdb_variable create -frame FRAME
110
   (it will also include permutations of the above options)
111
 
112
   NAME  = name of object to create. If no NAME, then automatically create
113
   a name
114
   EXPR  = the gdb expression for which to create a variable. This will
115
   be the most common usage.
116
   FRAME = the frame defining the scope of the variable.
117
 */
118
static int
119
gdb_variable_command (clientData, interp, objc, objv)
120
     ClientData clientData;
121
     Tcl_Interp *interp;
122
     int objc;
123
     Tcl_Obj *CONST objv[];
124
{
125
  static char *commands[] =
126
  {"create", "list", NULL};
127
  enum commands_enum
128
    {
129
      VARIABLE_CREATE, VARIABLE_LIST
130
    };
131
  int index, result;
132
 
133
  if (objc < 2)
134
    {
135
      Tcl_WrongNumArgs (interp, 1, objv, "option ?arg...?");
136
      return TCL_ERROR;
137
    }
138
 
139
  if (Tcl_GetIndexFromObj (interp, objv[1], commands, "options", 0,
140
                           &index) != TCL_OK)
141
    {
142
      return TCL_ERROR;
143
    }
144
 
145
  switch ((enum commands_enum) index)
146
    {
147
    case VARIABLE_CREATE:
148
      result = variable_create (interp, objc - 2, objv + 2);
149
      break;
150
 
151
    default:
152
      return TCL_ERROR;
153
    }
154
 
155
  return result;
156
}
157
 
158
/* This function implements the actual object command for each
159
   variable object that is created (and each of its children).
160
 
161
   Currently the following commands are implemented:
162
   - delete        delete this object and its children
163
   - update        update the variable and its children (root vars only)
164
   - numChildren   how many children does this object have
165
   - children      create the children and return a list of their objects
166
   - name          print out the name of this variable
167
   - format        query/set the display format of this variable
168
   - type          get the type of this variable
169
   - value         get/set the value of this variable
170
   - editable      is this variable editable?
171
 */
172
static int
173
variable_obj_command (clientData, interp, objc, objv)
174
     ClientData clientData;
175
     Tcl_Interp *interp;
176
     int objc;
177
     Tcl_Obj *CONST objv[];
178
{
179
  enum commands_enum
180
    {
181
      VARIABLE_DELETE,
182
      VARIABLE_NUM_CHILDREN,
183
      VARIABLE_CHILDREN,
184
      VARIABLE_FORMAT,
185
      VARIABLE_TYPE,
186
      VARIABLE_VALUE,
187
      VARIABLE_NAME,
188
      VARIABLE_EDITABLE,
189
      VARIABLE_UPDATE
190
    };
191
  static char *commands[] =
192
  {
193
    "delete",
194
    "numChildren",
195
    "children",
196
    "format",
197
    "type",
198
    "value",
199
    "name",
200
    "editable",
201
    "update",
202
    NULL
203
  };
204
  struct varobj *var;
205
  char *varobj_name;
206
  int index, result;
207
 
208
  /* Get the current handle for this variable token (name). */
209
  varobj_name = Tcl_GetStringFromObj (objv[0], NULL);
210
  if (varobj_name == NULL)
211
    return TCL_ERROR;
212
  var = varobj_get_handle (varobj_name);
213
 
214
 
215
  if (objc < 2)
216
    {
217
      Tcl_WrongNumArgs (interp, 1, objv, "option ?arg...?");
218
      return TCL_ERROR;
219
    }
220
 
221
  if (Tcl_GetIndexFromObj (interp, objv[1], commands, "options", 0,
222
                           &index) != TCL_OK)
223
    return TCL_ERROR;
224
 
225
  result = TCL_OK;
226
  switch ((enum commands_enum) index)
227
    {
228
    case VARIABLE_DELETE:
229
      if (objc > 2)
230
        {
231
          int len;
232
          char *s = Tcl_GetStringFromObj (objv[2], &len);
233
          if (*s == 'c' && strncmp (s, "children", len) == 0)
234
            {
235
              variable_delete (interp, var, 1 /* only children */ );
236
              break;
237
            }
238
        }
239
      variable_delete (interp, var, 0 /* var and children */ );
240
      break;
241
 
242
    case VARIABLE_NUM_CHILDREN:
243
      Tcl_SetObjResult (interp, Tcl_NewIntObj (varobj_get_num_children (var)));
244
      break;
245
 
246
    case VARIABLE_CHILDREN:
247
      {
248
        Tcl_Obj *children = variable_children (interp, var);
249
        Tcl_SetObjResult (interp, children);
250
      }
251
      break;
252
 
253
    case VARIABLE_FORMAT:
254
      result = variable_format (interp, objc, objv, var);
255
      break;
256
 
257
    case VARIABLE_TYPE:
258
      result = variable_type (interp, objc, objv, var);
259
      break;
260
 
261
    case VARIABLE_VALUE:
262
      result = variable_value (interp, objc, objv, var);
263
      break;
264
 
265
    case VARIABLE_NAME:
266
      {
267
        char *name = varobj_get_expression (var);
268
        Tcl_SetObjResult (interp, Tcl_NewStringObj (name, -1));
269
        FREEIF (name);
270
      }
271
      break;
272
 
273
    case VARIABLE_EDITABLE:
274
      Tcl_SetObjResult (interp, Tcl_NewIntObj (
275
                varobj_get_attributes (var) & 0x00000001 /* Editable? */ ));
276
      break;
277
 
278
    case VARIABLE_UPDATE:
279
      /* Only root variables can be updated */
280
      {
281
        Tcl_Obj *obj = variable_update (interp, var);
282
        Tcl_SetObjResult (interp, obj);
283
      }
284
      break;
285
 
286
    default:
287
      return TCL_ERROR;
288
    }
289
 
290
  return result;
291
}
292
 
293
/*
294
 * Variable object construction/destruction
295
 */
296
 
297
/* This function is responsible for processing the user's specifications
298
   and constructing a variable object. */
299
static int
300
variable_create (interp, objc, objv)
301
     Tcl_Interp *interp;
302
     int objc;
303
     Tcl_Obj *CONST objv[];
304
{
305
  enum create_opts
306
    {
307
      CREATE_EXPR, CREATE_FRAME
308
    };
309
  static char *create_options[] =
310
  {"-expr", "-frame", NULL};
311
  struct varobj *var;
312
  char *name;
313
  char *obj_name;
314
  int index;
315
  CORE_ADDR frame = (CORE_ADDR) -1;
316
  int how_specified = USE_SELECTED_FRAME;
317
 
318
  /* REMINDER: This command may be invoked in the following ways:
319
     gdb_variable create [NAME] [-expr EXPR] [-frame FRAME]
320
 
321
     NAME  = name of object to create. If no NAME, then automatically create
322
     a name
323
     EXPR  = the gdb expression for which to create a variable. This will
324
     be the most common usage.
325
     FRAME = the address of the frame defining the variable's scope
326
   */
327
  name = NULL;
328
  if (objc)
329
    name = Tcl_GetStringFromObj (objv[0], NULL);
330
  if (name == NULL || *name == '-')
331
    {
332
      /* generate a name for this object */
333
      obj_name = varobj_gen_name ();
334
    }
335
  else
336
    {
337
      /* specified name for object */
338
      obj_name = strdup (name);
339
      objv++;
340
      objc--;
341
    }
342
 
343
  /* Run through all the possible options for this command */
344
  name = NULL;
345
  while (objc > 0)
346
    {
347
      if (Tcl_GetIndexFromObj (interp, objv[0], create_options, "options",
348
                               0, &index) != TCL_OK)
349
        {
350
          free (obj_name);
351
          result_ptr->flags |= GDBTK_IN_TCL_RESULT;
352
          return TCL_ERROR;
353
        }
354
 
355
      switch ((enum create_opts) index)
356
        {
357
        case CREATE_EXPR:
358
          name = Tcl_GetStringFromObj (objv[1], NULL);
359
          objc--;
360
          objv++;
361
          break;
362
 
363
        case CREATE_FRAME:
364
          {
365
            char *str;
366
            str = Tcl_GetStringFromObj (objv[1], NULL);
367
            frame = parse_and_eval_address (str);
368
            how_specified = USE_SPECIFIED_FRAME;
369
            objc--;
370
            objv++;
371
          }
372
          break;
373
 
374
        default:
375
          break;
376
        }
377
 
378
      objc--;
379
      objv++;
380
    }
381
 
382
  /* Create the variable */
383
  var = varobj_create (obj_name, name, frame, how_specified);
384
 
385
  if (var != NULL)
386
    {
387
      /* Install a command into the interpreter that represents this
388
         object */
389
      install_variable (interp, obj_name, var);
390
      Tcl_SetObjResult (interp, Tcl_NewStringObj (obj_name, -1));
391
      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
392
 
393
      free (obj_name);
394
      return TCL_OK;
395
    }
396
 
397
  free (obj_name);
398
  return TCL_ERROR;
399
}
400
 
401
/* Delete the variable object VAR and its children */
402
/* If only_children_p, Delete only the children associated with the object. */
403
static void
404
variable_delete (interp, var, only_children_p)
405
     Tcl_Interp *interp;
406
     struct varobj *var;
407
     int only_children_p;
408
{
409
  char **dellist;
410
  char **vc;
411
 
412
  varobj_delete (var, &dellist, only_children_p);
413
 
414
  vc = dellist;
415
  while (*vc != NULL)
416
    {
417
      uninstall_variable (interp, *vc);
418
      free (*vc);
419
      vc++;
420
    }
421
 
422
  FREEIF (dellist);
423
}
424
 
425
/* Return a list of all the children of VAR, creating them if necessary. */
426
static Tcl_Obj *
427
variable_children (interp, var)
428
     Tcl_Interp *interp;
429
     struct varobj *var;
430
{
431
  Tcl_Obj *list;
432
  struct varobj **childlist;
433
  struct varobj **vc;
434
  char *childname;
435
 
436
  list = Tcl_NewListObj (0, NULL);
437
 
438
  varobj_list_children (var, &childlist);
439
 
440
  vc = childlist;
441
  while (*vc != NULL)
442
    {
443
      childname = varobj_get_objname (*vc);
444
      /* Add child to result list and install the Tcl command for it. */
445
      Tcl_ListObjAppendElement (NULL, list,
446
                                Tcl_NewStringObj (childname, -1));
447
      install_variable (interp, childname, *vc);
448
      vc++;
449
    }
450
 
451
  FREEIF (childlist);
452
  return list;
453
}
454
 
455
/* Update the values for a variable and its children. */
456
/* NOTE:   Only root variables can be updated... */
457
 
458
static Tcl_Obj *
459
variable_update (interp, var)
460
     Tcl_Interp *interp;
461
     struct varobj *var;
462
{
463
  Tcl_Obj *changed;
464
  struct varobj **changelist;
465
  struct varobj **vc;
466
 
467
  changed = Tcl_NewListObj (0, NULL);
468
 
469
  /* varobj_update() can return -1 if the variable is no longer around,
470
     i.e. we stepped out of the frame in which a local existed. */
471
  if (varobj_update (var, &changelist) == -1)
472
    return changed;
473
 
474
  vc = changelist;
475
  while (*vc != NULL)
476
    {
477
      /* Add changed variable object to result list */
478
      Tcl_ListObjAppendElement (NULL, changed,
479
                           Tcl_NewStringObj (varobj_get_objname (*vc), -1));
480
      vc++;
481
    }
482
 
483
  FREEIF (changelist);
484
  return changed;
485
}
486
 
487
/* This implements the format object command allowing
488
   the querying or setting of the object's display format. */
489
static int
490
variable_format (interp, objc, objv, var)
491
     Tcl_Interp *interp;
492
     int objc;
493
     Tcl_Obj *CONST objv[];
494
     struct varobj *var;
495
{
496
  if (objc > 2)
497
    {
498
      /* Set the format of VAR to given format */
499
      int len;
500
      char *fmt = Tcl_GetStringFromObj (objv[2], &len);
501
      if (STREQN (fmt, "natural", len))
502
        varobj_set_display_format (var, FORMAT_NATURAL);
503
      else if (STREQN (fmt, "binary", len))
504
        varobj_set_display_format (var, FORMAT_BINARY);
505
      else if (STREQN (fmt, "decimal", len))
506
        varobj_set_display_format (var, FORMAT_DECIMAL);
507
      else if (STREQN (fmt, "hexadecimal", len))
508
        varobj_set_display_format (var, FORMAT_HEXADECIMAL);
509
      else if (STREQN (fmt, "octal", len))
510
        varobj_set_display_format (var, FORMAT_OCTAL);
511
      else
512
        {
513
          Tcl_Obj *obj = Tcl_NewStringObj (NULL, 0);
514
          Tcl_AppendStringsToObj (obj, "unknown display format \"",
515
                                  fmt, "\": must be: \"natural\", \"binary\""
516
                      ", \"decimal\", \"hexadecimal\", or \"octal\"", NULL);
517
          Tcl_SetObjResult (interp, obj);
518
          return TCL_ERROR;
519
        }
520
    }
521
  else
522
    {
523
      /* Report the current format */
524
      Tcl_Obj *fmt;
525
 
526
      /* FIXME: Use varobj_format_string[] instead */
527
      fmt = Tcl_NewStringObj (
528
                  format_string[(int) varobj_get_display_format (var)], -1);
529
      Tcl_SetObjResult (interp, fmt);
530
    }
531
 
532
  return TCL_OK;
533
}
534
 
535
/* This function implements the type object command, which returns the type of a
536
   variable in the interpreter (or an error). */
537
static int
538
variable_type (interp, objc, objv, var)
539
     Tcl_Interp *interp;
540
     int objc;
541
     Tcl_Obj *CONST objv[];
542
     struct varobj *var;
543
{
544
  char *first, *last, *string;
545
  Tcl_RegExp regexp;
546
 
547
  /* For the "fake" variables, do not return a type.
548
     Their type is NULL anyway */
549
  /* FIXME: varobj_get_type() calls type_print(), so we may have to wrap
550
     its call here and return TCL_ERROR in the case it errors out */
551
  if ((string = varobj_get_type (var)) == NULL)
552
    {
553
      Tcl_ResetResult (interp);
554
      return TCL_OK;
555
    }
556
 
557
  first = string;
558
 
559
  /* gdb will print things out like "struct {...}" for anonymous structs.
560
     In gui-land, we don't want the {...}, so we strip it here. */
561
  regexp = Tcl_RegExpCompile (interp, "{...}");
562
  if (Tcl_RegExpExec (interp, regexp, string, first))
563
    {
564
      /* We have an anonymous struct/union/class/enum */
565
      Tcl_RegExpRange (regexp, 0, &first, &last);
566
      if (*(first - 1) == ' ')
567
        first--;
568
      *first = '\0';
569
    }
570
 
571
  Tcl_SetObjResult (interp, Tcl_NewStringObj (string, -1));
572
  FREEIF (string);
573
  return TCL_OK;
574
}
575
 
576
/* This function implements the value object command, which allows an object's
577
   value to be queried or set. */
578
static int
579
variable_value (interp, objc, objv, var)
580
     Tcl_Interp *interp;
581
     int objc;
582
     Tcl_Obj *CONST objv[];
583
     struct varobj *var;
584
{
585
  char *r;
586
 
587
  /* If we're setting the value of the variable, objv[2] will contain the
588
     variable's new value. */
589
  if (objc > 2)
590
    {
591
      /* FIXME: Do we need to test if val->error is set here?
592
         If so, make it an attribute. */
593
      if (varobj_get_attributes (var) & 0x00000001 /* Editable? */ )
594
        {
595
          char *s;
596
 
597
          s = Tcl_GetStringFromObj (objv[2], NULL);
598
          if (!varobj_set_value (var, s))
599
            {
600
              r = error_last_message ();
601
              Tcl_SetObjResult (interp, Tcl_NewStringObj (r, -1));
602
              FREEIF (r);
603
              return TCL_ERROR;
604
            }
605
        }
606
 
607
      Tcl_ResetResult (interp);
608
      return TCL_OK;
609
    }
610
 
611
  r = varobj_get_value (var);
612
 
613
  if (r == NULL)
614
    return TCL_ERROR;
615
  else
616
    {
617
      Tcl_SetObjResult (interp, Tcl_NewStringObj (r, -1));
618
      FREEIF (r);
619
      return TCL_OK;
620
    }
621
}
622
 
623
/* Helper functions for the above */
624
 
625
/* Install the given variable VAR into the tcl interpreter with
626
   the object name NAME. */
627
static void
628
install_variable (interp, name, var)
629
     Tcl_Interp *interp;
630
     char *name;
631
     struct varobj *var;
632
{
633
  Tcl_CreateObjCommand (interp, name, variable_obj_command,
634
                        (ClientData) var, NULL);
635
}
636
 
637
/* Unistall the object VAR in the tcl interpreter. */
638
static void
639
uninstall_variable (interp, varname)
640
     Tcl_Interp *interp;
641
     char *varname;
642
{
643
  Tcl_DeleteCommand (interp, varname);
644
}
645
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.