gdb/eval.c

   1 /* Evaluate expressions for GDB.
   2    Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994, 1995, 1996, 1997
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GDB.
   6
   7 This program is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2 of the License, or
  10 (at your option) any later version.
  11
  12 This program is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program; if not, write to the Free Software
  19 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
  20
  21 #include "defs.h"
  22 #include "gdb_string.h"
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "value.h"
  26 #include "expression.h"
  27 #include "target.h"
  28 #include "frame.h"
  29 #include "demangle.h"
  30 #include "language.h"   /* For CAST_IS_CONVERSION */
  31 #include "f-lang.h"     /* for array bound stuff */
  32 /* start-sanitize-gm */
  33 #ifdef GENERAL_MAGIC
  34 #include "gmagic.h"
  35 #endif /* GENERAL_MAGIC */
  36 /* end-sanitize-gm */
  37
  38 /* Prototypes for local functions. */
  39
  40 static value_ptr evaluate_subexp_for_sizeof PARAMS ((struct expression *,
  41                                                      int *));
  42
  43 static value_ptr evaluate_subexp_for_address PARAMS ((struct expression *,
  44                                                       int *, enum noside));
  45
  46 static value_ptr evaluate_subexp PARAMS ((struct type *, struct expression *,
  47                                           int *, enum noside));
  48
  49 static char *get_label PARAMS ((struct expression *, int *));
  50
  51 static value_ptr
  52 evaluate_struct_tuple PARAMS ((value_ptr, struct expression *, int *,
  53                                enum noside, int));
  54
  55 static LONGEST
  56 init_array_element PARAMS ((value_ptr, value_ptr, struct expression *,
  57                             int *, enum noside, LONGEST, LONGEST));
  58
  59 #ifdef __GNUC__
  60 inline
  61 #endif
  62 static value_ptr
  63 evaluate_subexp (expect_type, exp, pos, noside)
  64      struct type *expect_type;
  65      register struct expression *exp;
  66      register int *pos;
  67      enum noside noside;
  68 {
  69   return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
  70 }
  71 \f
  72 /* Parse the string EXP as a C expression, evaluate it,
  73    and return the result as a number.  */
  74
  75 CORE_ADDR
  76 parse_and_eval_address (exp)
  77      char *exp;
  78 {
  79   struct expression *expr = parse_expression (exp);
  80   register CORE_ADDR addr;
  81   register struct cleanup *old_chain =
  82       make_cleanup (free_current_contents, &expr);
  83
  84   addr = value_as_pointer (evaluate_expression (expr));
  85   do_cleanups (old_chain);
  86   return addr;
  87 }
  88
  89 /* Like parse_and_eval_address but takes a pointer to a char * variable
  90    and advanced that variable across the characters parsed.  */
  91
  92 CORE_ADDR
  93 parse_and_eval_address_1 (expptr)
  94      char **expptr;
  95 {
  96   struct expression *expr = parse_exp_1 (expptr, (struct block *)0, 0);
  97   register CORE_ADDR addr;
  98   register struct cleanup *old_chain =
  99       make_cleanup (free_current_contents, &expr);
 100
 101   addr = value_as_pointer (evaluate_expression (expr));
 102   do_cleanups (old_chain);
 103   return addr;
 104 }
 105
 106 value_ptr
 107 parse_and_eval (exp)
 108      char *exp;
 109 {
 110   struct expression *expr = parse_expression (exp);
 111   register value_ptr val;
 112   register struct cleanup *old_chain
 113     = make_cleanup (free_current_contents, &expr);
 114
 115   val = evaluate_expression (expr);
 116   do_cleanups (old_chain);
 117   return val;
 118 }
 119
 120 /* Parse up to a comma (or to a closeparen)
 121    in the string EXPP as an expression, evaluate it, and return the value.
 122    EXPP is advanced to point to the comma.  */
 123
 124 value_ptr
 125 parse_to_comma_and_eval (expp)
 126      char **expp;
 127 {
 128   struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
 129   register value_ptr val;
 130   register struct cleanup *old_chain
 131     = make_cleanup (free_current_contents, &expr);
 132
 133   val = evaluate_expression (expr);
 134   do_cleanups (old_chain);
 135   return val;
 136 }
 137 \f
 138 /* Evaluate an expression in internal prefix form
 139    such as is constructed by parse.y.
 140
 141    See expression.h for info on the format of an expression.  */
 142
 143 value_ptr
 144 evaluate_expression (exp)
 145      struct expression *exp;
 146 {
 147   int pc = 0;
 148   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
 149 }
 150
 151 /* Evaluate an expression, avoiding all memory references
 152    and getting a value whose type alone is correct.  */
 153
 154 value_ptr
 155 evaluate_type (exp)
 156      struct expression *exp;
 157 {
 158   int pc = 0;
 159   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
 160 }
 161
 162 /* If the next expression is an OP_LABELED, skips past it,
 163    returning the label.  Otherwise, does nothing and returns NULL. */
 164
 165 static char*
 166 get_label (exp, pos)
 167      register struct expression *exp;
 168      int *pos;
 169 {
 170   if (exp->elts[*pos].opcode == OP_LABELED)
 171     {
 172       int pc = (*pos)++;
 173       char *name = &exp->elts[pc + 2].string;
 174       int tem = longest_to_int (exp->elts[pc + 1].longconst);
 175       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 176       return name;
 177     }
 178   else
 179     return NULL;
 180 }
 181
 182 /* This function evaluates tupes (in Chill) or brace-initializers
 183    (in C/C++) for structure types.  */
 184
 185 static value_ptr
 186 evaluate_struct_tuple (struct_val, exp, pos, noside, nargs)
 187      value_ptr struct_val;
 188      register struct expression *exp;
 189      register int *pos;
 190      enum noside noside;
 191      int nargs;
 192 {
 193   struct type *struct_type = check_typedef (VALUE_TYPE (struct_val));
 194   struct type *substruct_type = struct_type;
 195   struct type *field_type;
 196   int fieldno = -1;
 197   int variantno = -1;
 198   int subfieldno = -1;
 199    while (--nargs >= 0)
 200     {
 201       int pc = *pos;
 202       value_ptr val = NULL;
 203       int nlabels = 0;
 204       int bitpos, bitsize;
 205       char *addr;
 206
 207       /* Skip past the labels, and count them. */
 208       while (get_label (exp, pos) != NULL)
 209         nlabels++;
 210
 211       do
 212         {
 213           char *label = get_label (exp, &pc);
 214           if (label)
 215             {
 216               for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
 217                    fieldno++)
 218                 {
 219                   char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
 220                   if (field_name != NULL && STREQ (field_name, label))
 221                     {
 222                       variantno = -1;
 223                       subfieldno = fieldno;
 224                       substruct_type = struct_type;
 225                       goto found;
 226                     }
 227                 }
 228               for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
 229                    fieldno++)
 230                 {
 231                   char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
 232                   field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
 233                   if ((field_name == 0 || *field_name == '\0')
 234                       && TYPE_CODE (field_type) == TYPE_CODE_UNION)
 235                     {
 236                       variantno = 0;
 237                       for (; variantno < TYPE_NFIELDS (field_type);
 238                            variantno++)
 239                         {
 240                           substruct_type
 241                             = TYPE_FIELD_TYPE (field_type, variantno);
 242                           if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
 243                             {
 244                               for (subfieldno = 0;
 245                                    subfieldno < TYPE_NFIELDS (substruct_type);
 246                                    subfieldno++)
 247                                 {
 248                                   if (STREQ (TYPE_FIELD_NAME (substruct_type,
 249                                                               subfieldno),
 250                                              label))
 251                                     {
 252                                       goto found;
 253                                     }
 254                                 }
 255                             }
 256                         }
 257                     }
 258                 }
 259               error ("there is no field named %s", label);
 260             found:
 261               ;
 262             }
 263           else
 264             {
 265               /* Unlabelled tuple element - go to next field. */
 266               if (variantno >= 0)
 267                 {
 268                   subfieldno++;
 269                   if (subfieldno >= TYPE_NFIELDS (substruct_type))
 270                     {
 271                       variantno = -1;
 272                       substruct_type = struct_type;
 273                     }
 274                 }
 275               if (variantno < 0)
 276                 {
 277                   fieldno++;
 278                   subfieldno = fieldno;
 279                   if (fieldno >= TYPE_NFIELDS (struct_type))
 280                     error ("too many initializers");
 281                   field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
 282                   if (TYPE_CODE (field_type) == TYPE_CODE_UNION
 283                       && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
 284                     error ("don't know which variant you want to set");
 285                 }
 286             }
 287
 288           /* Here, struct_type is the type of the inner struct,
 289              while substruct_type is the type of the inner struct.
 290              These are the same for normal structures, but a variant struct
 291              contains anonymous union fields that contain substruct fields.
 292              The value fieldno is the index of the top-level (normal or
 293              anonymous union) field in struct_field, while the value
 294              subfieldno is the index of the actual real (named inner) field
 295              in substruct_type. */
 296
 297           field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
 298           if (val == 0)
 299             val = evaluate_subexp (field_type, exp, pos, noside);
 300
 301           /* Now actually set the field in struct_val. */
 302
 303           /* Assign val to field fieldno. */
 304           if (VALUE_TYPE (val) != field_type)
 305             val = value_cast (field_type, val);
 306
 307           bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
 308           bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
 309           if (variantno >= 0)
 310             bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
 311           addr = VALUE_CONTENTS (struct_val) + bitpos / 8;
 312           if (bitsize)
 313             modify_field (addr, value_as_long (val),
 314                           bitpos % 8, bitsize);
 315           else
 316             memcpy (addr, VALUE_CONTENTS (val),
 317                     TYPE_LENGTH (VALUE_TYPE (val)));
 318         } while (--nlabels > 0);
 319     }
 320   return struct_val;
 321 }
 322
 323 /* Recursive helper function for setting elements of array tuples for Chill.
 324    The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND);
 325    the element value is ELEMENT;
 326    EXP, POS and NOSIDE are as usual.
 327    Evaluates index expresions and sets the specified element(s) of
 328    ARRAY to ELEMENT.
 329    Returns last index value.  */
 330
 331 static LONGEST
 332 init_array_element (array, element, exp, pos, noside, low_bound, high_bound)
 333      value_ptr array, element;
 334      register struct expression *exp;
 335      register int *pos;
 336      enum noside noside;
 337      LONGEST low_bound, high_bound;
 338 {
 339   LONGEST index;
 340   int element_size = TYPE_LENGTH (VALUE_TYPE (element));
 341   if (exp->elts[*pos].opcode == BINOP_COMMA)
 342     {
 343       (*pos)++;
 344       init_array_element (array, element, exp, pos, noside,
 345                           low_bound, high_bound);
 346       return init_array_element (array, element,
 347                                  exp, pos, noside, low_bound, high_bound);
 348     }
 349   else if (exp->elts[*pos].opcode == BINOP_RANGE)
 350     {
 351       LONGEST low, high;
 352       (*pos)++;
 353       low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 354       high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 355       if (low < low_bound || high > high_bound)
 356         error ("tuple range index out of range");
 357       for (index = low ; index <= high; index++)
 358         {
 359           memcpy (VALUE_CONTENTS_RAW (array)
 360                   + (index - low_bound) * element_size,
 361                   VALUE_CONTENTS (element), element_size);
 362         }
 363     }
 364   else
 365     {
 366       index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 367       if (index < low_bound || index > high_bound)
 368         error ("tuple index out of range");
 369       memcpy (VALUE_CONTENTS_RAW (array) + (index - low_bound) * element_size,
 370               VALUE_CONTENTS (element), element_size);
 371     }
 372   return index;
 373 }
 374
 375 value_ptr
 376 evaluate_subexp_standard (expect_type, exp, pos, noside)
 377      struct type *expect_type;
 378      register struct expression *exp;
 379      register int *pos;
 380      enum noside noside;
 381 {
 382   enum exp_opcode op;
 383   int tem, tem2, tem3;
 384   register int pc, pc2 = 0, oldpos;
 385   register value_ptr arg1 = NULL, arg2 = NULL, arg3;
 386   struct type *type;
 387   int nargs;
 388   value_ptr *argvec;
 389   int upper, lower, retcode;
 390   int code;
 391
 392   /* This expect_type crap should not be used for C.  C expressions do
 393      not have any notion of expected types, never has and (goddess
 394      willing) never will.  The C++ code uses it for some twisted
 395      purpose (I haven't investigated but I suspect it just the usual
 396      combination of Stroustrup figuring out some crazy language
 397      feature and Tiemann figuring out some crazier way to try to
 398      implement it).  CHILL has the tuple stuff; I don't know enough
 399      about CHILL to know whether expected types is the way to do it.
 400      FORTRAN I don't know.  */
 401   if (exp->language_defn->la_language != language_cplus
 402       && exp->language_defn->la_language != language_chill)
 403     expect_type = NULL_TYPE;
 404
 405   pc = (*pos)++;
 406   op = exp->elts[pc].opcode;
 407
 408   switch (op)
 409     {
 410     case OP_SCOPE:
 411       tem = longest_to_int (exp->elts[pc + 2].longconst);
 412       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
 413       arg1 = value_struct_elt_for_reference (exp->elts[pc + 1].type,
 414                                              0,
 415                                              exp->elts[pc + 1].type,
 416                                              &exp->elts[pc + 3].string,
 417                                              expect_type);
 418       if (arg1 == NULL)
 419         error ("There is no field named %s", &exp->elts[pc + 3].string);
 420       return arg1;
 421
 422     case OP_LONG:
 423       (*pos) += 3;
 424       return value_from_longest (exp->elts[pc + 1].type,
 425                                  exp->elts[pc + 2].longconst);
 426
 427     case OP_DOUBLE:
 428       (*pos) += 3;
 429       return value_from_double (exp->elts[pc + 1].type,
 430                                 exp->elts[pc + 2].doubleconst);
 431
 432     case OP_VAR_VALUE:
 433       (*pos) += 3;
 434       if (noside == EVAL_SKIP)
 435         goto nosideret;
 436       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 437         {
 438           struct symbol * sym = exp->elts[pc + 2].symbol;
 439           enum lval_type lv;
 440
 441           switch (SYMBOL_CLASS (sym))
 442             {
 443             case LOC_CONST:
 444             case LOC_LABEL:
 445             case LOC_CONST_BYTES:
 446               lv = not_lval;
 447               break;
 448
 449             case LOC_REGISTER:
 450             case LOC_REGPARM:
 451               lv = lval_register;
 452               break;
 453
 454             default:
 455               lv = lval_memory;
 456               break;
 457             }
 458
 459           return value_zero (SYMBOL_TYPE (sym), lv);
 460         }
 461       else
 462         return value_of_variable (exp->elts[pc + 2].symbol,
 463                                   exp->elts[pc + 1].block);
 464
 465     case OP_LAST:
 466       (*pos) += 2;
 467       return
 468         access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
 469
 470     case OP_REGISTER:
 471       (*pos) += 2;
 472       return value_of_register (longest_to_int (exp->elts[pc + 1].longconst));
 473
 474     case OP_BOOL:
 475       (*pos) += 2;
 476       return value_from_longest (LA_BOOL_TYPE,
 477                                    exp->elts[pc + 1].longconst);
 478
 479     case OP_INTERNALVAR:
 480       (*pos) += 2;
 481       return value_of_internalvar (exp->elts[pc + 1].internalvar);
 482
 483     case OP_STRING:
 484       tem = longest_to_int (exp->elts[pc + 1].longconst);
 485       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 486       if (noside == EVAL_SKIP)
 487         goto nosideret;
 488       return value_string (&exp->elts[pc + 2].string, tem);
 489
 490     case OP_BITSTRING:
 491       tem = longest_to_int (exp->elts[pc + 1].longconst);
 492       (*pos)
 493         += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
 494       if (noside == EVAL_SKIP)
 495         goto nosideret;
 496       return value_bitstring (&exp->elts[pc + 2].string, tem);
 497       break;
 498
 499     case OP_ARRAY:
 500       (*pos) += 3;
 501       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 502       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 503       nargs = tem3 - tem2 + 1;
 504       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 505
 506       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 507           && TYPE_CODE (type) == TYPE_CODE_STRUCT)
 508         {
 509           value_ptr rec = allocate_value (expect_type);
 510           memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
 511           return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
 512         }
 513
 514       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 515           && TYPE_CODE (type) == TYPE_CODE_ARRAY)
 516         {
 517           struct type *range_type = TYPE_FIELD_TYPE (type, 0);
 518           struct type *element_type = TYPE_TARGET_TYPE (type);
 519           value_ptr array = allocate_value (expect_type);
 520           int element_size = TYPE_LENGTH (check_typedef (element_type));
 521           LONGEST low_bound, high_bound, index;
 522           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 523             {
 524               low_bound = 0;
 525               high_bound = (TYPE_LENGTH (type) / element_size) - 1;
 526             }
 527           index = low_bound;
 528           memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
 529           for (tem = nargs;  --nargs >= 0;  )
 530             {
 531               value_ptr element;
 532               int index_pc = 0;
 533               if (exp->elts[*pos].opcode == BINOP_RANGE)
 534                 {
 535                   index_pc = ++(*pos);
 536                   evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 537                 }
 538               element = evaluate_subexp (element_type, exp, pos, noside);
 539               if (VALUE_TYPE (element) != element_type)
 540                 element = value_cast (element_type, element);
 541               if (index_pc)
 542                 {
 543                   int continue_pc = *pos;
 544                   *pos = index_pc;
 545                   index = init_array_element (array, element, exp, pos, noside,
 546                                               low_bound, high_bound);
 547                   *pos = continue_pc;
 548                 }
 549               else
 550                 {
 551                   if (index > high_bound)
 552                     /* to avoid memory corruption */
 553                     error ("Too many array elements");
 554                   memcpy (VALUE_CONTENTS_RAW (array)
 555                           + (index - low_bound) * element_size,
 556                           VALUE_CONTENTS (element),
 557                           element_size);
 558                 }
 559               index++;
 560             }
 561           return array;
 562         }
 563
 564       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 565           && TYPE_CODE (type) == TYPE_CODE_SET)
 566         {
 567           value_ptr set = allocate_value (expect_type);
 568           char *valaddr = VALUE_CONTENTS_RAW (set);
 569           struct type *element_type = TYPE_INDEX_TYPE (type);
 570           struct type *check_type = element_type;
 571           LONGEST low_bound, high_bound;
 572
 573           /* get targettype of elementtype */
 574           while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
 575                  TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
 576             check_type = TYPE_TARGET_TYPE (check_type);
 577
 578           if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
 579             error ("(power)set type with unknown size");
 580           memset (valaddr, '\0', TYPE_LENGTH (type));
 581           for (tem = 0; tem < nargs; tem++)
 582             {
 583               LONGEST range_low, range_high;
 584               struct type *range_low_type, *range_high_type;
 585               value_ptr elem_val;
 586               if (exp->elts[*pos].opcode == BINOP_RANGE)
 587                 {
 588                   (*pos)++;
 589                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 590                   range_low_type = VALUE_TYPE (elem_val);
 591                   range_low = value_as_long (elem_val);
 592                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 593                   range_high_type = VALUE_TYPE (elem_val);
 594                   range_high = value_as_long (elem_val);
 595                 }
 596               else
 597                 {
 598                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 599                   range_low_type = range_high_type = VALUE_TYPE (elem_val);
 600                   range_low = range_high = value_as_long (elem_val);
 601                 }
 602               /* check types of elements to avoid mixture of elements from
 603                  different types. Also check if type of element is "compatible"
 604                  with element type of powerset */
 605               if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
 606                 range_low_type = TYPE_TARGET_TYPE (range_low_type);
 607               if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
 608                 range_high_type = TYPE_TARGET_TYPE (range_high_type);
 609               if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
 610                   (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
 611                    (range_low_type != range_high_type)))
 612                 /* different element modes */
 613                 error ("POWERSET tuple elements of different mode");
 614               if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
 615                   (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
 616                    range_low_type != check_type))
 617                 error ("incompatible POWERSET tuple elements");
 618               if (range_low > range_high)
 619                 {
 620                   warning ("empty POWERSET tuple range");
 621                   continue;
 622                 }
 623               if (range_low < low_bound || range_high > high_bound)
 624                 error ("POWERSET tuple element out of range");
 625               range_low -= low_bound;
 626               range_high -= low_bound;
 627               for ( ; range_low <= range_high; range_low++)
 628                 {
 629                   int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
 630                   if (BITS_BIG_ENDIAN)
 631                     bit_index = TARGET_CHAR_BIT - 1 - bit_index;
 632                   valaddr [(unsigned) range_low / TARGET_CHAR_BIT]
 633                     |= 1 << bit_index;
 634                 }
 635             }
 636           return set;
 637         }
 638
 639       argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
 640       for (tem = 0; tem < nargs; tem++)
 641         {
 642           /* Ensure that array expressions are coerced into pointer objects. */
 643           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 644         }
 645       if (noside == EVAL_SKIP)
 646         goto nosideret;
 647       return value_array (tem2, tem3, argvec);
 648
 649     case TERNOP_SLICE:
 650       {
 651         value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 652         int lowbound
 653           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 654         int upper
 655           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 656         if (noside == EVAL_SKIP)
 657           goto nosideret;
 658         return value_slice (array, lowbound, upper - lowbound + 1);
 659       }
 660
 661     case TERNOP_SLICE_COUNT:
 662       {
 663         value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 664         int lowbound
 665           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 666         int length
 667           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 668         return value_slice (array, lowbound, length);
 669       }
 670
 671     case TERNOP_COND:
 672       /* Skip third and second args to evaluate the first one.  */
 673       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 674       if (value_logical_not (arg1))
 675         {
 676           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 677           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 678         }
 679       else
 680         {
 681           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 682           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 683           return arg2;
 684         }
 685
 686     case OP_FUNCALL:
 687       (*pos) += 2;
 688       op = exp->elts[*pos].opcode;
 689       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 690       /* Allocate arg vector, including space for the function to be
 691          called in argvec[0] and a terminating NULL */
 692       argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 3));
 693       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 694         {
 695           LONGEST fnptr;
 696
 697           nargs++;
 698           /* First, evaluate the structure into arg2 */
 699           pc2 = (*pos)++;
 700
 701           if (noside == EVAL_SKIP)
 702             goto nosideret;
 703
 704           if (op == STRUCTOP_MEMBER)
 705             {
 706               arg2 = evaluate_subexp_for_address (exp, pos, noside);
 707             }
 708           else
 709             {
 710               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 711             }
 712
 713           /* If the function is a virtual function, then the
 714              aggregate value (providing the structure) plays
 715              its part by providing the vtable.  Otherwise,
 716              it is just along for the ride: call the function
 717              directly.  */
 718
 719           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 720
 721           fnptr = value_as_long (arg1);
 722
 723           if (METHOD_PTR_IS_VIRTUAL(fnptr))
 724             {
 725               int fnoffset = METHOD_PTR_TO_VOFFSET(fnptr);
 726               struct type *basetype;
 727               struct type *domain_type =
 728                   TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
 729               int i, j;
 730               basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
 731               if (domain_type != basetype)
 732                   arg2 = value_cast(lookup_pointer_type (domain_type), arg2);
 733               basetype = TYPE_VPTR_BASETYPE (domain_type);
 734               for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
 735                 {
 736                   struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
 737                   /* If one is virtual, then all are virtual.  */
 738                   if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
 739                     for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
 740                       if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
 741                         {
 742                           value_ptr temp = value_ind (arg2);
 743                           arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
 744                           arg2 = value_addr (temp);
 745                           goto got_it;
 746                         }
 747                 }
 748               if (i < 0)
 749                 error ("virtual function at index %d not found", fnoffset);
 750             }
 751           else
 752             {
 753               VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
 754             }
 755         got_it:
 756
 757           /* Now, say which argument to start evaluating from */
 758           tem = 2;
 759         }
 760       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 761         {
 762           /* Hair for method invocations */
 763           int tem2;
 764
 765           nargs++;
 766           /* First, evaluate the structure into arg2 */
 767           pc2 = (*pos)++;
 768           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
 769           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
 770           if (noside == EVAL_SKIP)
 771             goto nosideret;
 772
 773           if (op == STRUCTOP_STRUCT)
 774             {
 775               /* If v is a variable in a register, and the user types
 776                  v.method (), this will produce an error, because v has
 777                  no address.
 778
 779                  A possible way around this would be to allocate a
 780                  copy of the variable on the stack, copy in the
 781                  contents, call the function, and copy out the
 782                  contents.  I.e. convert this from call by reference
 783                  to call by copy-return (or whatever it's called).
 784                  However, this does not work because it is not the
 785                  same: the method being called could stash a copy of
 786                  the address, and then future uses through that address
 787                  (after the method returns) would be expected to
 788                  use the variable itself, not some copy of it.  */
 789               arg2 = evaluate_subexp_for_address (exp, pos, noside);
 790             }
 791           else
 792             {
 793               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 794             }
 795           /* Now, say which argument to start evaluating from */
 796           tem = 2;
 797         }
 798       else
 799         {
 800           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
 801           tem = 1;
 802           type = VALUE_TYPE (argvec[0]);
 803           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
 804             type = TYPE_TARGET_TYPE (type);
 805           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
 806             {
 807               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
 808                 {
 809                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem-1),
 810                                                  exp, pos, noside);
 811                 }
 812             }
 813         }
 814
 815       for (; tem <= nargs; tem++)
 816         {
 817           /* Ensure that array expressions are coerced into pointer objects. */
 818
 819           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 820         }
 821
 822       /* signal end of arglist */
 823       argvec[tem] = 0;
 824
 825       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 826         {
 827           int static_memfuncp;
 828           value_ptr temp = arg2;
 829           char tstr[64];
 830
 831           argvec[1] = arg2;
 832           argvec[0] = 0;
 833           strcpy(tstr, &exp->elts[pc2+2].string);
 834           if (!argvec[0])
 835             {
 836               temp = arg2;
 837               argvec[0] =
 838               value_struct_elt (&temp, argvec+1, tstr,
 839                               &static_memfuncp,
 840                               op == STRUCTOP_STRUCT
 841                               ? "structure" : "structure pointer");
 842             }
 843           arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
 844                          VALUE_ADDRESS (temp)+VALUE_OFFSET (temp));
 845           argvec[1] = arg2;
 846
 847           if (static_memfuncp)
 848             {
 849               argvec[1] = argvec[0];
 850               nargs--;
 851               argvec++;
 852             }
 853         }
 854       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 855         {
 856           argvec[1] = arg2;
 857           argvec[0] = arg1;
 858         }
 859
 860     do_call_it:
 861
 862       if (noside == EVAL_SKIP)
 863         goto nosideret;
 864       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 865         {
 866           /* If the return type doesn't look like a function type, call an
 867              error.  This can happen if somebody tries to turn a variable into
 868              a function call. This is here because people often want to
 869              call, eg, strcmp, which gdb doesn't know is a function.  If
 870              gdb isn't asked for it's opinion (ie. through "whatis"),
 871              it won't offer it. */
 872
 873           struct type *ftype =
 874             TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
 875
 876           if (ftype)
 877             return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
 878           else
 879             error ("Expression of type other than \"Function returning ...\" used as function");
 880         }
 881       return call_function_by_hand (argvec[0], nargs, argvec + 1);
 882
 883     case OP_F77_UNDETERMINED_ARGLIST:
 884
 885       /* Remember that in F77, functions, substring ops and
 886          array subscript operations cannot be disambiguated
 887          at parse time.  We have made all array subscript operations,
 888          substring operations as well as function calls  come here
 889          and we now have to discover what the heck this thing actually was.
 890          If it is a function, we process just as if we got an OP_FUNCALL. */
 891
 892       nargs = longest_to_int (exp->elts[pc+1].longconst);
 893       (*pos) += 2;
 894
 895       /* First determine the type code we are dealing with.  */
 896       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 897       type = check_typedef (VALUE_TYPE (arg1));
 898       code = TYPE_CODE (type);
 899
 900       switch (code)
 901         {
 902         case TYPE_CODE_ARRAY:
 903           goto multi_f77_subscript;
 904
 905         case TYPE_CODE_STRING:
 906           goto op_f77_substr;
 907
 908         case TYPE_CODE_PTR:
 909         case TYPE_CODE_FUNC:
 910           /* It's a function call. */
 911           /* Allocate arg vector, including space for the function to be
 912              called in argvec[0] and a terminating NULL */
 913           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 914           argvec[0] = arg1;
 915           tem = 1;
 916           for (; tem <= nargs; tem++)
 917             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 918           argvec[tem] = 0; /* signal end of arglist */
 919           goto do_call_it;
 920
 921         default:
 922               error ("Cannot perform substring on this type");
 923         }
 924
 925     op_f77_substr:
 926       /* We have a substring operation on our hands here,
 927          let us get the string we will be dealing with */
 928
 929       /* Now evaluate the 'from' and 'to' */
 930
 931       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 932
 933       if (nargs < 2)
 934         return value_subscript (arg1, arg2);
 935
 936       arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
 937
 938       if (noside == EVAL_SKIP)
 939         goto nosideret;
 940
 941       tem2 = value_as_long (arg2);
 942       tem3 = value_as_long (arg3);
 943
 944       return value_slice (arg1, tem2, tem3 - tem2 + 1);
 945
 946     case OP_COMPLEX:
 947       /* We have a complex number, There should be 2 floating
 948          point numbers that compose it */
 949       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 950       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 951
 952       return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
 953
 954     case STRUCTOP_STRUCT:
 955       tem = longest_to_int (exp->elts[pc + 1].longconst);
 956       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 957       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 958       if (noside == EVAL_SKIP)
 959         goto nosideret;
 960       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 961         return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
 962                                                    &exp->elts[pc + 2].string,
 963                                                    0),
 964                            lval_memory);
 965       else
 966         {
 967           value_ptr temp = arg1;
 968           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
 969                                    NULL, "structure");
 970         }
 971
 972     case STRUCTOP_PTR:
 973       tem = longest_to_int (exp->elts[pc + 1].longconst);
 974       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 975       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 976       if (noside == EVAL_SKIP)
 977         goto nosideret;
 978       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 979         return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
 980                                                    &exp->elts[pc + 2].string,
 981                                                    0),
 982                            lval_memory);
 983       else
 984         {
 985           value_ptr temp = arg1;
 986           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
 987                                    NULL, "structure pointer");
 988         }
 989
 990 /* start-sanitize-gm */
 991 #ifdef GENERAL_MAGIC
 992     case STRUCTOP_FIELD:
 993       tem = longest_to_int (exp->elts[pc + 1].longconst);
 994       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 995       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 996       if (noside == EVAL_SKIP)
 997         goto nosideret;
 998       {
 999         CORE_ADDR object = value_as_long (arg1);
1000         struct type *type = type_of_object (object);
1001
1002         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1003           return value_zero (lookup_struct_elt_type (type,
1004                                                      &exp->elts[pc + 2].string,
1005                                                      0),
1006                              lval_memory);
1007         else
1008           {
1009             value_ptr temp = value_from_longest (builtin_type_unsigned_long,
1010                                                  baseptr_of_object (value_as_long(arg1)));
1011
1012             VALUE_TYPE (temp) = type;
1013             return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1014                                      NULL, "structure pointer");
1015           }
1016       }
1017 #endif /* GENERAL_MAGIC */
1018 /* end-sanitize-gm */
1019
1020     case STRUCTOP_MEMBER:
1021       arg1 = evaluate_subexp_for_address (exp, pos, noside);
1022       goto handle_pointer_to_member;
1023     case STRUCTOP_MPTR:
1024       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1025     handle_pointer_to_member:
1026       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1027       if (noside == EVAL_SKIP)
1028         goto nosideret;
1029       type = check_typedef (VALUE_TYPE (arg2));
1030       if (TYPE_CODE (type) != TYPE_CODE_PTR)
1031         goto bad_pointer_to_member;
1032       type = check_typedef (TYPE_TARGET_TYPE (type));
1033       if (TYPE_CODE (type) == TYPE_CODE_METHOD)
1034         error ("not implemented: pointer-to-method in pointer-to-member construct");
1035       if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
1036         goto bad_pointer_to_member;
1037       /* Now, convert these values to an address.  */
1038       arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1039                          arg1);
1040       arg3 = value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1041                                  value_as_long (arg1) + value_as_long (arg2));
1042       return value_ind (arg3);
1043     bad_pointer_to_member:
1044       error("non-pointer-to-member value used in pointer-to-member construct");
1045
1046     case BINOP_CONCAT:
1047       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1048       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1049       if (noside == EVAL_SKIP)
1050         goto nosideret;
1051       if (binop_user_defined_p (op, arg1, arg2))
1052         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1053       else
1054         return value_concat (arg1, arg2);
1055
1056     case BINOP_ASSIGN:
1057       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1058       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1059       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1060         return arg1;
1061       if (binop_user_defined_p (op, arg1, arg2))
1062         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1063       else
1064         return value_assign (arg1, arg2);
1065
1066     case BINOP_ASSIGN_MODIFY:
1067       (*pos) += 2;
1068       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1069       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1070       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1071         return arg1;
1072       op = exp->elts[pc + 1].opcode;
1073       if (binop_user_defined_p (op, arg1, arg2))
1074         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1075       else if (op == BINOP_ADD)
1076         arg2 = value_add (arg1, arg2);
1077       else if (op == BINOP_SUB)
1078         arg2 = value_sub (arg1, arg2);
1079       else
1080         arg2 = value_binop (arg1, arg2, op);
1081       return value_assign (arg1, arg2);
1082
1083     case BINOP_ADD:
1084       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1085       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1086       if (noside == EVAL_SKIP)
1087         goto nosideret;
1088       if (binop_user_defined_p (op, arg1, arg2))
1089         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1090       else
1091         return value_add (arg1, arg2);
1092
1093     case BINOP_SUB:
1094       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1095       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1096       if (noside == EVAL_SKIP)
1097         goto nosideret;
1098       if (binop_user_defined_p (op, arg1, arg2))
1099         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1100       else
1101         return value_sub (arg1, arg2);
1102
1103     case BINOP_MUL:
1104     case BINOP_DIV:
1105     case BINOP_REM:
1106     case BINOP_MOD:
1107     case BINOP_LSH:
1108     case BINOP_RSH:
1109     case BINOP_BITWISE_AND:
1110     case BINOP_BITWISE_IOR:
1111     case BINOP_BITWISE_XOR:
1112       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1113       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1114       if (noside == EVAL_SKIP)
1115         goto nosideret;
1116       if (binop_user_defined_p (op, arg1, arg2))
1117         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1118       else
1119         if (noside == EVAL_AVOID_SIDE_EFFECTS
1120             && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
1121           return value_zero (VALUE_TYPE (arg1), not_lval);
1122       else
1123         return value_binop (arg1, arg2, op);
1124
1125     case BINOP_RANGE:
1126       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1127       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1128       if (noside == EVAL_SKIP)
1129         goto nosideret;
1130       error ("':' operator used in invalid context");
1131
1132     case BINOP_SUBSCRIPT:
1133       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1134       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1135       if (noside == EVAL_SKIP)
1136         goto nosideret;
1137       if (binop_user_defined_p (op, arg1, arg2))
1138         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1139       else
1140         {
1141           /* If the user attempts to subscript something that is not an
1142              array or pointer type (like a plain int variable for example),
1143              then report this as an error. */
1144
1145           COERCE_REF (arg1);
1146           type = check_typedef (VALUE_TYPE (arg1));
1147           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1148               && TYPE_CODE (type) != TYPE_CODE_PTR)
1149             {
1150               if (TYPE_NAME (type))
1151                 error ("cannot subscript something of type `%s'",
1152                        TYPE_NAME (type));
1153               else
1154                 error ("cannot subscript requested type");
1155             }
1156
1157           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1158             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1159           else
1160             return value_subscript (arg1, arg2);
1161         }
1162
1163     case BINOP_IN:
1164       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1165       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1166       if (noside == EVAL_SKIP)
1167         goto nosideret;
1168       return value_in (arg1, arg2);
1169
1170     case MULTI_SUBSCRIPT:
1171       (*pos) += 2;
1172       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1173       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1174       while (nargs-- > 0)
1175         {
1176           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1177           /* FIXME:  EVAL_SKIP handling may not be correct. */
1178           if (noside == EVAL_SKIP)
1179             {
1180               if (nargs > 0)
1181                 {
1182                   continue;
1183                 }
1184               else
1185                 {
1186                   goto nosideret;
1187                 }
1188             }
1189           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1190           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1191             {
1192               /* If the user attempts to subscript something that has no target
1193                  type (like a plain int variable for example), then report this
1194                  as an error. */
1195
1196               type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
1197               if (type != NULL)
1198                 {
1199                   arg1 = value_zero (type, VALUE_LVAL (arg1));
1200                   noside = EVAL_SKIP;
1201                   continue;
1202                 }
1203               else
1204                 {
1205                   error ("cannot subscript something of type `%s'",
1206                          TYPE_NAME (VALUE_TYPE (arg1)));
1207                 }
1208             }
1209
1210           if (binop_user_defined_p (op, arg1, arg2))
1211             {
1212               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1213             }
1214           else
1215             {
1216               arg1 = value_subscript (arg1, arg2);
1217             }
1218         }
1219       return (arg1);
1220
1221     multi_f77_subscript:
1222       {
1223         int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of
1224                                                     subscripts, max == 7 */
1225         int array_size_array[MAX_FORTRAN_DIMS+1];
1226         int ndimensions=1,i;
1227         struct type *tmp_type;
1228         int offset_item;   /* The array offset where the item lives */
1229
1230         if (nargs > MAX_FORTRAN_DIMS)
1231           error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
1232
1233         tmp_type = check_typedef (VALUE_TYPE (arg1));
1234         ndimensions = calc_f77_array_dims (type);
1235
1236         if (nargs != ndimensions)
1237           error ("Wrong number of subscripts");
1238
1239         /* Now that we know we have a legal array subscript expression
1240            let us actually find out where this element exists in the array. */
1241
1242         offset_item = 0;
1243         for (i = 1; i <= nargs; i++)
1244           {
1245             /* Evaluate each subscript, It must be a legal integer in F77 */
1246             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1247
1248             /* Fill in the subscript and array size arrays */
1249
1250             subscript_array[i] = value_as_long (arg2);
1251
1252             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1253             if (retcode == BOUND_FETCH_ERROR)
1254               error ("Cannot obtain dynamic upper bound");
1255
1256             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1257             if (retcode == BOUND_FETCH_ERROR)
1258               error("Cannot obtain dynamic lower bound");
1259
1260             array_size_array[i] = upper - lower + 1;
1261
1262             /* Zero-normalize subscripts so that offsetting will work. */
1263
1264             subscript_array[i] -= lower;
1265
1266             /* If we are at the bottom of a multidimensional
1267                array type then keep a ptr to the last ARRAY
1268                type around for use when calling value_subscript()
1269                below. This is done because we pretend to value_subscript
1270                that we actually have a one-dimensional array
1271                of base element type that we apply a simple
1272                offset to. */
1273
1274             if (i < nargs)
1275               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1276           }
1277
1278         /* Now let us calculate the offset for this item */
1279
1280         offset_item = subscript_array[ndimensions];
1281
1282         for (i = ndimensions - 1; i >= 1; i--)
1283           offset_item =
1284             array_size_array[i] * offset_item + subscript_array[i];
1285
1286         /* Construct a value node with the value of the offset */
1287
1288         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1289
1290         /* Let us now play a dirty trick: we will take arg1
1291            which is a value node pointing to the topmost level
1292            of the multidimensional array-set and pretend
1293            that it is actually a array of the final element
1294            type, this will ensure that value_subscript()
1295            returns the correct type value */
1296
1297         VALUE_TYPE (arg1) = tmp_type;
1298         return value_ind (value_add (value_coerce_array (arg1), arg2));
1299       }
1300
1301     case BINOP_LOGICAL_AND:
1302       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1303       if (noside == EVAL_SKIP)
1304         {
1305           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1306           goto nosideret;
1307         }
1308
1309       oldpos = *pos;
1310       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1311       *pos = oldpos;
1312
1313       if (binop_user_defined_p (op, arg1, arg2))
1314         {
1315           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1316           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1317         }
1318       else
1319         {
1320           tem = value_logical_not (arg1);
1321           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1322                                   (tem ? EVAL_SKIP : noside));
1323           return value_from_longest (LA_BOOL_TYPE,
1324                                   (LONGEST) (!tem && !value_logical_not (arg2)));
1325         }
1326
1327     case BINOP_LOGICAL_OR:
1328       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1329       if (noside == EVAL_SKIP)
1330         {
1331           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1332           goto nosideret;
1333         }
1334
1335       oldpos = *pos;
1336       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1337       *pos = oldpos;
1338
1339       if (binop_user_defined_p (op, arg1, arg2))
1340         {
1341           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1342           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1343         }
1344       else
1345         {
1346           tem = value_logical_not (arg1);
1347           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1348                                   (!tem ? EVAL_SKIP : noside));
1349           return value_from_longest (LA_BOOL_TYPE,
1350                                   (LONGEST) (!tem || !value_logical_not (arg2)));
1351         }
1352
1353     case BINOP_EQUAL:
1354       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1355       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1356       if (noside == EVAL_SKIP)
1357         goto nosideret;
1358       if (binop_user_defined_p (op, arg1, arg2))
1359         {
1360           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1361         }
1362       else
1363         {
1364           tem = value_equal (arg1, arg2);
1365           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1366         }
1367
1368     case BINOP_NOTEQUAL:
1369       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1370       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1371       if (noside == EVAL_SKIP)
1372         goto nosideret;
1373       if (binop_user_defined_p (op, arg1, arg2))
1374         {
1375           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1376         }
1377       else
1378         {
1379           tem = value_equal (arg1, arg2);
1380           return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1381         }
1382
1383     case BINOP_LESS:
1384       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1385       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1386       if (noside == EVAL_SKIP)
1387         goto nosideret;
1388       if (binop_user_defined_p (op, arg1, arg2))
1389         {
1390           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1391         }
1392       else
1393         {
1394           tem = value_less (arg1, arg2);
1395           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1396         }
1397
1398     case BINOP_GTR:
1399       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1400       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1401       if (noside == EVAL_SKIP)
1402         goto nosideret;
1403       if (binop_user_defined_p (op, arg1, arg2))
1404         {
1405           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1406         }
1407       else
1408         {
1409           tem = value_less (arg2, arg1);
1410           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1411         }
1412
1413     case BINOP_GEQ:
1414       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1415       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1416       if (noside == EVAL_SKIP)
1417         goto nosideret;
1418       if (binop_user_defined_p (op, arg1, arg2))
1419         {
1420           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1421         }
1422       else
1423         {
1424           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1425           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1426         }
1427
1428     case BINOP_LEQ:
1429       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1430       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1431       if (noside == EVAL_SKIP)
1432         goto nosideret;
1433       if (binop_user_defined_p (op, arg1, arg2))
1434         {
1435           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1436         }
1437       else
1438         {
1439           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1440           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1441         }
1442
1443     case BINOP_REPEAT:
1444       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1445       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1446       if (noside == EVAL_SKIP)
1447         goto nosideret;
1448       type = check_typedef (VALUE_TYPE (arg2));
1449       if (TYPE_CODE (type) != TYPE_CODE_INT)
1450         error ("Non-integral right operand for \"@\" operator.");
1451       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1452         {
1453           return allocate_repeat_value (VALUE_TYPE (arg1),
1454                                         longest_to_int (value_as_long (arg2)));
1455         }
1456       else
1457         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1458
1459     case BINOP_COMMA:
1460       evaluate_subexp (NULL_TYPE, exp, pos, noside);
1461       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1462
1463     case UNOP_NEG:
1464       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1465       if (noside == EVAL_SKIP)
1466         goto nosideret;
1467       if (unop_user_defined_p (op, arg1))
1468         return value_x_unop (arg1, op, noside);
1469       else
1470         return value_neg (arg1);
1471
1472     case UNOP_COMPLEMENT:
1473       /* C++: check for and handle destructor names.  */
1474       op = exp->elts[*pos].opcode;
1475
1476       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1477       if (noside == EVAL_SKIP)
1478         goto nosideret;
1479       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1480         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1481       else
1482         return value_complement (arg1);
1483
1484     case UNOP_LOGICAL_NOT:
1485       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1486       if (noside == EVAL_SKIP)
1487         goto nosideret;
1488       if (unop_user_defined_p (op, arg1))
1489         return value_x_unop (arg1, op, noside);
1490       else
1491         return value_from_longest (builtin_type_int,
1492                                    (LONGEST) value_logical_not (arg1));
1493
1494     case UNOP_IND:
1495       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1496         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1497       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1498       if (noside == EVAL_SKIP)
1499         goto nosideret;
1500       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1501         {
1502           type = check_typedef (VALUE_TYPE (arg1));
1503           if (TYPE_CODE (type) == TYPE_CODE_PTR
1504               || TYPE_CODE (type) == TYPE_CODE_REF
1505               /* In C you can dereference an array to get the 1st elt.  */
1506               || TYPE_CODE (type) == TYPE_CODE_ARRAY
1507               )
1508             return value_zero (TYPE_TARGET_TYPE (type),
1509                                lval_memory);
1510           else if (TYPE_CODE (type) == TYPE_CODE_INT)
1511             /* GDB allows dereferencing an int.  */
1512             return value_zero (builtin_type_int, lval_memory);
1513           else
1514             error ("Attempt to take contents of a non-pointer value.");
1515         }
1516       return value_ind (arg1);
1517
1518     case UNOP_ADDR:
1519       /* C++: check for and handle pointer to members.  */
1520
1521       op = exp->elts[*pos].opcode;
1522
1523       if (noside == EVAL_SKIP)
1524         {
1525           if (op == OP_SCOPE)
1526             {
1527               int temm = longest_to_int (exp->elts[pc+3].longconst);
1528               (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1529             }
1530           else
1531             evaluate_subexp (expect_type, exp, pos, EVAL_SKIP);
1532           goto nosideret;
1533         }
1534
1535       return evaluate_subexp_for_address (exp, pos, noside);
1536
1537     case UNOP_SIZEOF:
1538       if (noside == EVAL_SKIP)
1539         {
1540           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1541           goto nosideret;
1542         }
1543       return evaluate_subexp_for_sizeof (exp, pos);
1544
1545     case UNOP_CAST:
1546       (*pos) += 2;
1547       type = exp->elts[pc + 1].type;
1548       arg1 = evaluate_subexp (type, exp, pos, noside);
1549       if (noside == EVAL_SKIP)
1550         goto nosideret;
1551       if (type != VALUE_TYPE (arg1))
1552         arg1 = value_cast (type, arg1);
1553       return arg1;
1554
1555     case UNOP_MEMVAL:
1556       (*pos) += 2;
1557       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1558       if (noside == EVAL_SKIP)
1559         goto nosideret;
1560       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1561         return value_zero (exp->elts[pc + 1].type, lval_memory);
1562       else
1563         return value_at_lazy (exp->elts[pc + 1].type,
1564                               value_as_pointer (arg1),
1565                               NULL);
1566
1567     case UNOP_PREINCREMENT:
1568       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1569       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1570         return arg1;
1571       else if (unop_user_defined_p (op, arg1))
1572         {
1573           return value_x_unop (arg1, op, noside);
1574         }
1575       else
1576         {
1577           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1578                                                    (LONGEST) 1));
1579           return value_assign (arg1, arg2);
1580         }
1581
1582     case UNOP_PREDECREMENT:
1583       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1584       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1585         return arg1;
1586       else if (unop_user_defined_p (op, arg1))
1587         {
1588           return value_x_unop (arg1, op, noside);
1589         }
1590       else
1591         {
1592           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1593                                                    (LONGEST) 1));
1594           return value_assign (arg1, arg2);
1595         }
1596
1597     case UNOP_POSTINCREMENT:
1598       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1599       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1600         return arg1;
1601       else if (unop_user_defined_p (op, arg1))
1602         {
1603           return value_x_unop (arg1, op, noside);
1604         }
1605       else
1606         {
1607           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1608                                                    (LONGEST) 1));
1609           value_assign (arg1, arg2);
1610           return arg1;
1611         }
1612
1613     case UNOP_POSTDECREMENT:
1614       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1615       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1616         return arg1;
1617       else if (unop_user_defined_p (op, arg1))
1618         {
1619           return value_x_unop (arg1, op, noside);
1620         }
1621       else
1622         {
1623           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1624                                                    (LONGEST) 1));
1625           value_assign (arg1, arg2);
1626           return arg1;
1627         }
1628
1629     case OP_THIS:
1630       (*pos) += 1;
1631       return value_of_this (1);
1632
1633     case OP_TYPE:
1634       error ("Attempt to use a type name as an expression");
1635
1636     default:
1637       /* Removing this case and compiling with gcc -Wall reveals that
1638          a lot of cases are hitting this case.  Some of these should
1639          probably be removed from expression.h (e.g. do we need a BINOP_SCOPE
1640          and an OP_SCOPE?); others are legitimate expressions which are
1641          (apparently) not fully implemented.
1642
1643          If there are any cases landing here which mean a user error,
1644          then they should be separate cases, with more descriptive
1645          error messages.  */
1646
1647       error ("\
1648 GDB does not (yet) know how to evaluate that kind of expression");
1649     }
1650
1651  nosideret:
1652   return value_from_longest (builtin_type_long, (LONGEST) 1);
1653 }
1654 \f
1655 /* Evaluate a subexpression of EXP, at index *POS,
1656    and return the address of that subexpression.
1657    Advance *POS over the subexpression.
1658    If the subexpression isn't an lvalue, get an error.
1659    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
1660    then only the type of the result need be correct.  */
1661
1662 static value_ptr
1663 evaluate_subexp_for_address (exp, pos, noside)
1664      register struct expression *exp;
1665      register int *pos;
1666      enum noside noside;
1667 {
1668   enum exp_opcode op;
1669   register int pc;
1670   struct symbol *var;
1671
1672   pc = (*pos);
1673   op = exp->elts[pc].opcode;
1674
1675   switch (op)
1676     {
1677     case UNOP_IND:
1678       (*pos)++;
1679       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1680
1681     case UNOP_MEMVAL:
1682       (*pos) += 3;
1683       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
1684                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
1685
1686     case OP_VAR_VALUE:
1687       var = exp->elts[pc + 2].symbol;
1688
1689       /* C++: The "address" of a reference should yield the address
1690        * of the object pointed to. Let value_addr() deal with it. */
1691       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
1692         goto default_case;
1693
1694       (*pos) += 4;
1695       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1696         {
1697           struct type *type =
1698             lookup_pointer_type (SYMBOL_TYPE (var));
1699           enum address_class sym_class = SYMBOL_CLASS (var);
1700
1701           if (sym_class == LOC_CONST
1702               || sym_class == LOC_CONST_BYTES
1703               || sym_class == LOC_REGISTER
1704               || sym_class == LOC_REGPARM)
1705             error ("Attempt to take address of register or constant.");
1706
1707         return
1708           value_zero (type, not_lval);
1709         }
1710       else
1711         return
1712           locate_var_value
1713             (var,
1714              block_innermost_frame (exp->elts[pc + 1].block));
1715
1716     default:
1717     default_case:
1718       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1719         {
1720           value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1721           if (VALUE_LVAL (x) == lval_memory)
1722             return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
1723                                not_lval);
1724           else
1725             error ("Attempt to take address of non-lval");
1726         }
1727       return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1728     }
1729 }
1730
1731 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
1732    When used in contexts where arrays will be coerced anyway, this is
1733    equivalent to `evaluate_subexp' but much faster because it avoids
1734    actually fetching array contents (perhaps obsolete now that we have
1735    VALUE_LAZY).
1736
1737    Note that we currently only do the coercion for C expressions, where
1738    arrays are zero based and the coercion is correct.  For other languages,
1739    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
1740    to decide if coercion is appropriate.
1741
1742    */
1743
1744 value_ptr
1745 evaluate_subexp_with_coercion (exp, pos, noside)
1746      register struct expression *exp;
1747      register int *pos;
1748      enum noside noside;
1749 {
1750   register enum exp_opcode op;
1751   register int pc;
1752   register value_ptr val;
1753   struct symbol *var;
1754
1755   pc = (*pos);
1756   op = exp->elts[pc].opcode;
1757
1758   switch (op)
1759     {
1760     case OP_VAR_VALUE:
1761       var = exp->elts[pc + 2].symbol;
1762       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
1763           && CAST_IS_CONVERSION)
1764         {
1765           (*pos) += 4;
1766           val =
1767             locate_var_value
1768               (var, block_innermost_frame (exp->elts[pc + 1].block));
1769           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (SYMBOL_TYPE (var))),
1770                              val);
1771         }
1772       /* FALLTHROUGH */
1773
1774     default:
1775       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1776     }
1777 }
1778
1779 /* Evaluate a subexpression of EXP, at index *POS,
1780    and return a value for the size of that subexpression.
1781    Advance *POS over the subexpression.  */
1782
1783 static value_ptr
1784 evaluate_subexp_for_sizeof (exp, pos)
1785      register struct expression *exp;
1786      register int *pos;
1787 {
1788   enum exp_opcode op;
1789   register int pc;
1790   struct type *type;
1791   value_ptr val;
1792
1793   pc = (*pos);
1794   op = exp->elts[pc].opcode;
1795
1796   switch (op)
1797     {
1798       /* This case is handled specially
1799          so that we avoid creating a value for the result type.
1800          If the result type is very big, it's desirable not to
1801          create a value unnecessarily.  */
1802     case UNOP_IND:
1803       (*pos)++;
1804       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1805       type = check_typedef (VALUE_TYPE (val));
1806       if (TYPE_CODE (type) != TYPE_CODE_PTR
1807           && TYPE_CODE (type) != TYPE_CODE_REF
1808           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
1809         error ("Attempt to take contents of a non-pointer value.");
1810       type = check_typedef (TYPE_TARGET_TYPE (type));
1811       return value_from_longest (builtin_type_int, (LONGEST)
1812                       TYPE_LENGTH (type));
1813
1814     case UNOP_MEMVAL:
1815       (*pos) += 3;
1816       type = check_typedef (exp->elts[pc + 1].type);
1817       return value_from_longest (builtin_type_int,
1818                                  (LONGEST) TYPE_LENGTH (type));
1819
1820     case OP_VAR_VALUE:
1821       (*pos) += 4;
1822       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
1823       return
1824         value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
1825
1826     default:
1827       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1828       return value_from_longest (builtin_type_int,
1829                               (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
1830     }
1831 }
1832
1833 /* Parse a type expression in the string [P..P+LENGTH). */
1834
1835 struct type *
1836 parse_and_eval_type (p, length)
1837      char *p;
1838      int length;
1839 {
1840     char *tmp = (char *)alloca (length + 4);
1841     struct expression *expr;
1842     tmp[0] = '(';
1843     memcpy (tmp+1, p, length);
1844     tmp[length+1] = ')';
1845     tmp[length+2] = '0';
1846     tmp[length+3] = '\0';
1847     expr = parse_expression (tmp);
1848     if (expr->elts[0].opcode != UNOP_CAST)
1849         error ("Internal error in eval_type.");
1850     return expr->elts[1].type;
1851 }
1852
1853 int
1854 calc_f77_array_dims (array_type)
1855      struct type *array_type;
1856 {
1857   int ndimen = 1;
1858   struct type *tmp_type;
1859
1860   if ((TYPE_CODE(array_type) != TYPE_CODE_ARRAY))
1861     error ("Can't get dimensions for a non-array type");
1862
1863   tmp_type = array_type;
1864
1865   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
1866     {
1867       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
1868         ++ndimen;
1869     }
1870   return ndimen;
1871 }