gdb/eval.c

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