gdb/eval.c

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