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, 2002
   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, selected_frame);
 451         (*pos) += 2;
 452         if (val == NULL)
 453           error ("Value of register %s not available.", REGISTER_NAME (regno));
 454         else
 455           return val;
 456       }
 457     case OP_BOOL:
 458       (*pos) += 2;
 459       return value_from_longest (LA_BOOL_TYPE,
 460                                  exp->elts[pc + 1].longconst);
 461
 462     case OP_INTERNALVAR:
 463       (*pos) += 2;
 464       return value_of_internalvar (exp->elts[pc + 1].internalvar);
 465
 466     case OP_STRING:
 467       tem = longest_to_int (exp->elts[pc + 1].longconst);
 468       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 469       if (noside == EVAL_SKIP)
 470         goto nosideret;
 471       return value_string (&exp->elts[pc + 2].string, tem);
 472
 473     case OP_BITSTRING:
 474       tem = longest_to_int (exp->elts[pc + 1].longconst);
 475       (*pos)
 476         += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
 477       if (noside == EVAL_SKIP)
 478         goto nosideret;
 479       return value_bitstring (&exp->elts[pc + 2].string, tem);
 480       break;
 481
 482     case OP_ARRAY:
 483       (*pos) += 3;
 484       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 485       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 486       nargs = tem3 - tem2 + 1;
 487       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 488
 489       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 490           && TYPE_CODE (type) == TYPE_CODE_STRUCT)
 491         {
 492           struct value *rec = allocate_value (expect_type);
 493           memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
 494           return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
 495         }
 496
 497       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 498           && TYPE_CODE (type) == TYPE_CODE_ARRAY)
 499         {
 500           struct type *range_type = TYPE_FIELD_TYPE (type, 0);
 501           struct type *element_type = TYPE_TARGET_TYPE (type);
 502           struct value *array = allocate_value (expect_type);
 503           int element_size = TYPE_LENGTH (check_typedef (element_type));
 504           LONGEST low_bound, high_bound, index;
 505           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 506             {
 507               low_bound = 0;
 508               high_bound = (TYPE_LENGTH (type) / element_size) - 1;
 509             }
 510           index = low_bound;
 511           memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
 512           for (tem = nargs; --nargs >= 0;)
 513             {
 514               struct value *element;
 515               int index_pc = 0;
 516               if (exp->elts[*pos].opcode == BINOP_RANGE)
 517                 {
 518                   index_pc = ++(*pos);
 519                   evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 520                 }
 521               element = evaluate_subexp (element_type, exp, pos, noside);
 522               if (VALUE_TYPE (element) != element_type)
 523                 element = value_cast (element_type, element);
 524               if (index_pc)
 525                 {
 526                   int continue_pc = *pos;
 527                   *pos = index_pc;
 528                   index = init_array_element (array, element, exp, pos, noside,
 529                                               low_bound, high_bound);
 530                   *pos = continue_pc;
 531                 }
 532               else
 533                 {
 534                   if (index > high_bound)
 535                     /* to avoid memory corruption */
 536                     error ("Too many array elements");
 537                   memcpy (VALUE_CONTENTS_RAW (array)
 538                           + (index - low_bound) * element_size,
 539                           VALUE_CONTENTS (element),
 540                           element_size);
 541                 }
 542               index++;
 543             }
 544           return array;
 545         }
 546
 547       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 548           && TYPE_CODE (type) == TYPE_CODE_SET)
 549         {
 550           struct value *set = allocate_value (expect_type);
 551           char *valaddr = VALUE_CONTENTS_RAW (set);
 552           struct type *element_type = TYPE_INDEX_TYPE (type);
 553           struct type *check_type = element_type;
 554           LONGEST low_bound, high_bound;
 555
 556           /* get targettype of elementtype */
 557           while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
 558                  TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
 559             check_type = TYPE_TARGET_TYPE (check_type);
 560
 561           if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
 562             error ("(power)set type with unknown size");
 563           memset (valaddr, '\0', TYPE_LENGTH (type));
 564           for (tem = 0; tem < nargs; tem++)
 565             {
 566               LONGEST range_low, range_high;
 567               struct type *range_low_type, *range_high_type;
 568               struct value *elem_val;
 569               if (exp->elts[*pos].opcode == BINOP_RANGE)
 570                 {
 571                   (*pos)++;
 572                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 573                   range_low_type = VALUE_TYPE (elem_val);
 574                   range_low = value_as_long (elem_val);
 575                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 576                   range_high_type = VALUE_TYPE (elem_val);
 577                   range_high = value_as_long (elem_val);
 578                 }
 579               else
 580                 {
 581                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 582                   range_low_type = range_high_type = VALUE_TYPE (elem_val);
 583                   range_low = range_high = value_as_long (elem_val);
 584                 }
 585               /* check types of elements to avoid mixture of elements from
 586                  different types. Also check if type of element is "compatible"
 587                  with element type of powerset */
 588               if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
 589                 range_low_type = TYPE_TARGET_TYPE (range_low_type);
 590               if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
 591                 range_high_type = TYPE_TARGET_TYPE (range_high_type);
 592               if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
 593                   (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
 594                    (range_low_type != range_high_type)))
 595                 /* different element modes */
 596                 error ("POWERSET tuple elements of different mode");
 597               if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
 598                   (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
 599                    range_low_type != check_type))
 600                 error ("incompatible POWERSET tuple elements");
 601               if (range_low > range_high)
 602                 {
 603                   warning ("empty POWERSET tuple range");
 604                   continue;
 605                 }
 606               if (range_low < low_bound || range_high > high_bound)
 607                 error ("POWERSET tuple element out of range");
 608               range_low -= low_bound;
 609               range_high -= low_bound;
 610               for (; range_low <= range_high; range_low++)
 611                 {
 612                   int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
 613                   if (BITS_BIG_ENDIAN)
 614                     bit_index = TARGET_CHAR_BIT - 1 - bit_index;
 615                   valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
 616                     |= 1 << bit_index;
 617                 }
 618             }
 619           return set;
 620         }
 621
 622       argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
 623       for (tem = 0; tem < nargs; tem++)
 624         {
 625           /* Ensure that array expressions are coerced into pointer objects. */
 626           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 627         }
 628       if (noside == EVAL_SKIP)
 629         goto nosideret;
 630       return value_array (tem2, tem3, argvec);
 631
 632     case TERNOP_SLICE:
 633       {
 634         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 635         int lowbound
 636         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 637         int upper
 638         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 639         if (noside == EVAL_SKIP)
 640           goto nosideret;
 641         return value_slice (array, lowbound, upper - lowbound + 1);
 642       }
 643
 644     case TERNOP_SLICE_COUNT:
 645       {
 646         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 647         int lowbound
 648         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 649         int length
 650         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 651         return value_slice (array, lowbound, length);
 652       }
 653
 654     case TERNOP_COND:
 655       /* Skip third and second args to evaluate the first one.  */
 656       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 657       if (value_logical_not (arg1))
 658         {
 659           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 660           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 661         }
 662       else
 663         {
 664           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 665           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 666           return arg2;
 667         }
 668
 669     case OP_FUNCALL:
 670       (*pos) += 2;
 671       op = exp->elts[*pos].opcode;
 672       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 673       /* Allocate arg vector, including space for the function to be
 674          called in argvec[0] and a terminating NULL */
 675       argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
 676       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 677         {
 678           LONGEST fnptr;
 679
 680           /* 1997-08-01 Currently we do not support function invocation
 681              via pointers-to-methods with HP aCC. Pointer does not point
 682              to the function, but possibly to some thunk. */
 683           if (hp_som_som_object_present)
 684             {
 685               error ("Not implemented: function invocation through pointer to method with HP aCC");
 686             }
 687
 688           nargs++;
 689           /* First, evaluate the structure into arg2 */
 690           pc2 = (*pos)++;
 691
 692           if (noside == EVAL_SKIP)
 693             goto nosideret;
 694
 695           if (op == STRUCTOP_MEMBER)
 696             {
 697               arg2 = evaluate_subexp_for_address (exp, pos, noside);
 698             }
 699           else
 700             {
 701               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 702             }
 703
 704           /* If the function is a virtual function, then the
 705              aggregate value (providing the structure) plays
 706              its part by providing the vtable.  Otherwise,
 707              it is just along for the ride: call the function
 708              directly.  */
 709
 710           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 711
 712           fnptr = value_as_long (arg1);
 713
 714           if (METHOD_PTR_IS_VIRTUAL (fnptr))
 715             {
 716               int fnoffset = METHOD_PTR_TO_VOFFSET (fnptr);
 717               struct type *basetype;
 718               struct type *domain_type =
 719               TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
 720               int i, j;
 721               basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
 722               if (domain_type != basetype)
 723                 arg2 = value_cast (lookup_pointer_type (domain_type), arg2);
 724               basetype = TYPE_VPTR_BASETYPE (domain_type);
 725               for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
 726                 {
 727                   struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
 728                   /* If one is virtual, then all are virtual.  */
 729                   if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
 730                     for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
 731                       if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
 732                         {
 733                           struct value *temp = value_ind (arg2);
 734                           arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
 735                           arg2 = value_addr (temp);
 736                           goto got_it;
 737                         }
 738                 }
 739               if (i < 0)
 740                 error ("virtual function at index %d not found", fnoffset);
 741             }
 742           else
 743             {
 744               VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
 745             }
 746         got_it:
 747
 748           /* Now, say which argument to start evaluating from */
 749           tem = 2;
 750         }
 751       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 752         {
 753           /* Hair for method invocations */
 754           int tem2;
 755
 756           nargs++;
 757           /* First, evaluate the structure into arg2 */
 758           pc2 = (*pos)++;
 759           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
 760           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
 761           if (noside == EVAL_SKIP)
 762             goto nosideret;
 763
 764           if (op == STRUCTOP_STRUCT)
 765             {
 766               /* If v is a variable in a register, and the user types
 767                  v.method (), this will produce an error, because v has
 768                  no address.
 769
 770                  A possible way around this would be to allocate a
 771                  copy of the variable on the stack, copy in the
 772                  contents, call the function, and copy out the
 773                  contents.  I.e. convert this from call by reference
 774                  to call by copy-return (or whatever it's called).
 775                  However, this does not work because it is not the
 776                  same: the method being called could stash a copy of
 777                  the address, and then future uses through that address
 778                  (after the method returns) would be expected to
 779                  use the variable itself, not some copy of it.  */
 780               arg2 = evaluate_subexp_for_address (exp, pos, noside);
 781             }
 782           else
 783             {
 784               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 785             }
 786           /* Now, say which argument to start evaluating from */
 787           tem = 2;
 788         }
 789       else
 790         {
 791           /* Non-method function call */
 792           save_pos1 = *pos;
 793           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
 794           tem = 1;
 795           type = VALUE_TYPE (argvec[0]);
 796           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
 797             type = TYPE_TARGET_TYPE (type);
 798           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
 799             {
 800               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
 801                 {
 802                   /* pai: FIXME This seems to be coercing arguments before
 803                    * overload resolution has been done! */
 804                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
 805                                                  exp, pos, noside);
 806                 }
 807             }
 808         }
 809
 810       /* Evaluate arguments */
 811       for (; tem <= nargs; tem++)
 812         {
 813           /* Ensure that array expressions are coerced into pointer objects. */
 814           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 815         }
 816
 817       /* signal end of arglist */
 818       argvec[tem] = 0;
 819
 820       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 821         {
 822           int static_memfuncp;
 823           char tstr[256];
 824
 825           /* Method invocation : stuff "this" as first parameter */
 826           argvec[1] = arg2;
 827           /* Name of method from expression */
 828           strcpy (tstr, &exp->elts[pc2 + 2].string);
 829
 830           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
 831             {
 832               /* Language is C++, do some overload resolution before evaluation */
 833               struct value *valp = NULL;
 834
 835               /* Prepare list of argument types for overload resolution */
 836               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
 837               for (ix = 1; ix <= nargs; ix++)
 838                 arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
 839
 840               (void) find_overload_match (arg_types, nargs, tstr,
 841                                      1 /* method */ , 0 /* strict match */ ,
 842                                           &arg2 /* the object */ , NULL,
 843                                           &valp, NULL, &static_memfuncp);
 844
 845
 846               argvec[1] = arg2; /* the ``this'' pointer */
 847               argvec[0] = valp; /* use the method found after overload resolution */
 848             }
 849           else
 850             /* Non-C++ case -- or no overload resolution */
 851             {
 852               struct value *temp = arg2;
 853               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
 854                                             &static_memfuncp,
 855                                             op == STRUCTOP_STRUCT
 856                                        ? "structure" : "structure pointer");
 857               /* value_struct_elt updates temp with the correct value
 858                  of the ``this'' pointer if necessary, so modify argvec[1] to
 859                  reflect any ``this'' changes.  */
 860               arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
 861                              VALUE_ADDRESS (temp) + VALUE_OFFSET (temp)
 862                              + VALUE_EMBEDDED_OFFSET (temp));
 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 }