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