gdb/eval.c

   1 /* Evaluate expressions for GDB.
   2
   3    Copyright (C) 1986-2019 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 3 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, see <http://www.gnu.org/licenses/>.  */
  19
  20 #include "defs.h"
  21 #include "symtab.h"
  22 #include "gdbtypes.h"
  23 #include "value.h"
  24 #include "expression.h"
  25 #include "target.h"
  26 #include "frame.h"
  27 #include "gdbthread.h"
  28 #include "language.h"           /* For CAST_IS_CONVERSION.  */
  29 #include "f-lang.h"             /* For array bound stuff.  */
  30 #include "cp-abi.h"
  31 #include "infcall.h"
  32 #include "objc-lang.h"
  33 #include "block.h"
  34 #include "parser-defs.h"
  35 #include "cp-support.h"
  36 #include "ui-out.h"
  37 #include "regcache.h"
  38 #include "user-regs.h"
  39 #include "valprint.h"
  40 #include "gdb_obstack.h"
  41 #include "objfiles.h"
  42 #include "typeprint.h"
  43 #include <ctype.h>
  44
  45 /* This is defined in valops.c */
  46 extern int overload_resolution;
  47
  48 /* Prototypes for local functions.  */
  49
  50 static struct value *evaluate_subexp_for_sizeof (struct expression *, int *,
  51                                                  enum noside);
  52
  53 static struct value *evaluate_subexp_for_address (struct expression *,
  54                                                   int *, enum noside);
  55
  56 static value *evaluate_subexp_for_cast (expression *exp, int *pos,
  57                                         enum noside noside,
  58                                         struct type *type);
  59
  60 static struct value *evaluate_struct_tuple (struct value *,
  61                                             struct expression *, int *,
  62                                             enum noside, int);
  63
  64 static LONGEST init_array_element (struct value *, struct value *,
  65                                    struct expression *, int *, enum noside,
  66                                    LONGEST, LONGEST);
  67
  68 struct value *
  69 evaluate_subexp (struct type *expect_type, struct expression *exp,
  70                  int *pos, enum noside noside)
  71 {
  72   struct value *retval;
  73
  74   gdb::optional<enable_thread_stack_temporaries> stack_temporaries;
  75   if (*pos == 0 && target_has_execution
  76       && exp->language_defn->la_language == language_cplus
  77       && !thread_stack_temporaries_enabled_p (inferior_thread ()))
  78     stack_temporaries.emplace (inferior_thread ());
  79
  80   retval = (*exp->language_defn->la_exp_desc->evaluate_exp)
  81     (expect_type, exp, pos, noside);
  82
  83   if (stack_temporaries.has_value ()
  84       && value_in_thread_stack_temporaries (retval, inferior_thread ()))
  85     retval = value_non_lval (retval);
  86
  87   return retval;
  88 }
  89 \f
  90 /* Parse the string EXP as a C expression, evaluate it,
  91    and return the result as a number.  */
  92
  93 CORE_ADDR
  94 parse_and_eval_address (const char *exp)
  95 {
  96   expression_up expr = parse_expression (exp);
  97
  98   return value_as_address (evaluate_expression (expr.get ()));
  99 }
 100
 101 /* Like parse_and_eval_address, but treats the value of the expression
 102    as an integer, not an address, returns a LONGEST, not a CORE_ADDR.  */
 103 LONGEST
 104 parse_and_eval_long (const char *exp)
 105 {
 106   expression_up expr = parse_expression (exp);
 107
 108   return value_as_long (evaluate_expression (expr.get ()));
 109 }
 110
 111 struct value *
 112 parse_and_eval (const char *exp)
 113 {
 114   expression_up expr = parse_expression (exp);
 115
 116   return evaluate_expression (expr.get ());
 117 }
 118
 119 /* Parse up to a comma (or to a closeparen)
 120    in the string EXPP as an expression, evaluate it, and return the value.
 121    EXPP is advanced to point to the comma.  */
 122
 123 struct value *
 124 parse_to_comma_and_eval (const char **expp)
 125 {
 126   expression_up expr = parse_exp_1 (expp, 0, (struct block *) 0, 1);
 127
 128   return evaluate_expression (expr.get ());
 129 }
 130 \f
 131 /* Evaluate an expression in internal prefix form
 132    such as is constructed by parse.y.
 133
 134    See expression.h for info on the format of an expression.  */
 135
 136 struct value *
 137 evaluate_expression (struct expression *exp)
 138 {
 139   int pc = 0;
 140
 141   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
 142 }
 143
 144 /* Evaluate an expression, avoiding all memory references
 145    and getting a value whose type alone is correct.  */
 146
 147 struct value *
 148 evaluate_type (struct expression *exp)
 149 {
 150   int pc = 0;
 151
 152   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
 153 }
 154
 155 /* Evaluate a subexpression, avoiding all memory references and
 156    getting a value whose type alone is correct.  */
 157
 158 struct value *
 159 evaluate_subexpression_type (struct expression *exp, int subexp)
 160 {
 161   return evaluate_subexp (NULL_TYPE, exp, &subexp, EVAL_AVOID_SIDE_EFFECTS);
 162 }
 163
 164 /* Find the current value of a watchpoint on EXP.  Return the value in
 165    *VALP and *RESULTP and the chain of intermediate and final values
 166    in *VAL_CHAIN.  RESULTP and VAL_CHAIN may be NULL if the caller does
 167    not need them.
 168
 169    If PRESERVE_ERRORS is true, then exceptions are passed through.
 170    Otherwise, if PRESERVE_ERRORS is false, then if a memory error
 171    occurs while evaluating the expression, *RESULTP will be set to
 172    NULL.  *RESULTP may be a lazy value, if the result could not be
 173    read from memory.  It is used to determine whether a value is
 174    user-specified (we should watch the whole value) or intermediate
 175    (we should watch only the bit used to locate the final value).
 176
 177    If the final value, or any intermediate value, could not be read
 178    from memory, *VALP will be set to NULL.  *VAL_CHAIN will still be
 179    set to any referenced values.  *VALP will never be a lazy value.
 180    This is the value which we store in struct breakpoint.
 181
 182    If VAL_CHAIN is non-NULL, the values put into *VAL_CHAIN will be
 183    released from the value chain.  If VAL_CHAIN is NULL, all generated
 184    values will be left on the value chain.  */
 185
 186 void
 187 fetch_subexp_value (struct expression *exp, int *pc, struct value **valp,
 188                     struct value **resultp,
 189                     std::vector<value_ref_ptr> *val_chain,
 190                     int preserve_errors)
 191 {
 192   struct value *mark, *new_mark, *result;
 193
 194   *valp = NULL;
 195   if (resultp)
 196     *resultp = NULL;
 197   if (val_chain)
 198     val_chain->clear ();
 199
 200   /* Evaluate the expression.  */
 201   mark = value_mark ();
 202   result = NULL;
 203
 204   TRY
 205     {
 206       result = evaluate_subexp (NULL_TYPE, exp, pc, EVAL_NORMAL);
 207     }
 208   CATCH (ex, RETURN_MASK_ALL)
 209     {
 210       /* Ignore memory errors if we want watchpoints pointing at
 211          inaccessible memory to still be created; otherwise, throw the
 212          error to some higher catcher.  */
 213       switch (ex.error)
 214         {
 215         case MEMORY_ERROR:
 216           if (!preserve_errors)
 217             break;
 218           /* Fall through.  */
 219         default:
 220           throw_exception (ex);
 221           break;
 222         }
 223     }
 224   END_CATCH
 225
 226   new_mark = value_mark ();
 227   if (mark == new_mark)
 228     return;
 229   if (resultp)
 230     *resultp = result;
 231
 232   /* Make sure it's not lazy, so that after the target stops again we
 233      have a non-lazy previous value to compare with.  */
 234   if (result != NULL)
 235     {
 236       if (!value_lazy (result))
 237         *valp = result;
 238       else
 239         {
 240
 241           TRY
 242             {
 243               value_fetch_lazy (result);
 244               *valp = result;
 245             }
 246           CATCH (except, RETURN_MASK_ERROR)
 247             {
 248             }
 249           END_CATCH
 250         }
 251     }
 252
 253   if (val_chain)
 254     {
 255       /* Return the chain of intermediate values.  We use this to
 256          decide which addresses to watch.  */
 257       *val_chain = value_release_to_mark (mark);
 258     }
 259 }
 260
 261 /* Extract a field operation from an expression.  If the subexpression
 262    of EXP starting at *SUBEXP is not a structure dereference
 263    operation, return NULL.  Otherwise, return the name of the
 264    dereferenced field, and advance *SUBEXP to point to the
 265    subexpression of the left-hand-side of the dereference.  This is
 266    used when completing field names.  */
 267
 268 const char *
 269 extract_field_op (struct expression *exp, int *subexp)
 270 {
 271   int tem;
 272   char *result;
 273
 274   if (exp->elts[*subexp].opcode != STRUCTOP_STRUCT
 275       && exp->elts[*subexp].opcode != STRUCTOP_PTR)
 276     return NULL;
 277   tem = longest_to_int (exp->elts[*subexp + 1].longconst);
 278   result = &exp->elts[*subexp + 2].string;
 279   (*subexp) += 1 + 3 + BYTES_TO_EXP_ELEM (tem + 1);
 280   return result;
 281 }
 282
 283 /* This function evaluates brace-initializers (in C/C++) for
 284    structure types.  */
 285
 286 static struct value *
 287 evaluate_struct_tuple (struct value *struct_val,
 288                        struct expression *exp,
 289                        int *pos, enum noside noside, int nargs)
 290 {
 291   struct type *struct_type = check_typedef (value_type (struct_val));
 292   struct type *field_type;
 293   int fieldno = -1;
 294
 295   while (--nargs >= 0)
 296     {
 297       struct value *val = NULL;
 298       int bitpos, bitsize;
 299       bfd_byte *addr;
 300
 301       fieldno++;
 302       /* Skip static fields.  */
 303       while (fieldno < TYPE_NFIELDS (struct_type)
 304              && field_is_static (&TYPE_FIELD (struct_type,
 305                                               fieldno)))
 306         fieldno++;
 307       if (fieldno >= TYPE_NFIELDS (struct_type))
 308         error (_("too many initializers"));
 309       field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
 310       if (TYPE_CODE (field_type) == TYPE_CODE_UNION
 311           && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
 312         error (_("don't know which variant you want to set"));
 313
 314       /* Here, struct_type is the type of the inner struct,
 315          while substruct_type is the type of the inner struct.
 316          These are the same for normal structures, but a variant struct
 317          contains anonymous union fields that contain substruct fields.
 318          The value fieldno is the index of the top-level (normal or
 319          anonymous union) field in struct_field, while the value
 320          subfieldno is the index of the actual real (named inner) field
 321          in substruct_type.  */
 322
 323       field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
 324       if (val == 0)
 325         val = evaluate_subexp (field_type, exp, pos, noside);
 326
 327       /* Now actually set the field in struct_val.  */
 328
 329       /* Assign val to field fieldno.  */
 330       if (value_type (val) != field_type)
 331         val = value_cast (field_type, val);
 332
 333       bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
 334       bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
 335       addr = value_contents_writeable (struct_val) + bitpos / 8;
 336       if (bitsize)
 337         modify_field (struct_type, addr,
 338                       value_as_long (val), bitpos % 8, bitsize);
 339       else
 340         memcpy (addr, value_contents (val),
 341                 TYPE_LENGTH (value_type (val)));
 342
 343     }
 344   return struct_val;
 345 }
 346
 347 /* Recursive helper function for setting elements of array tuples.
 348    The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND); the
 349    element value is ELEMENT; EXP, POS and NOSIDE are as usual.
 350    Evaluates index expresions and sets the specified element(s) of
 351    ARRAY to ELEMENT.  Returns last index value.  */
 352
 353 static LONGEST
 354 init_array_element (struct value *array, struct value *element,
 355                     struct expression *exp, int *pos,
 356                     enum noside noside, LONGEST low_bound, LONGEST high_bound)
 357 {
 358   LONGEST index;
 359   int element_size = TYPE_LENGTH (value_type (element));
 360
 361   if (exp->elts[*pos].opcode == BINOP_COMMA)
 362     {
 363       (*pos)++;
 364       init_array_element (array, element, exp, pos, noside,
 365                           low_bound, high_bound);
 366       return init_array_element (array, element,
 367                                  exp, pos, noside, low_bound, high_bound);
 368     }
 369   else
 370     {
 371       index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 372       if (index < low_bound || index > high_bound)
 373         error (_("tuple index out of range"));
 374       memcpy (value_contents_raw (array) + (index - low_bound) * element_size,
 375               value_contents (element), element_size);
 376     }
 377   return index;
 378 }
 379
 380 static struct value *
 381 value_f90_subarray (struct value *array,
 382                     struct expression *exp, int *pos, enum noside noside)
 383 {
 384   int pc = (*pos) + 1;
 385   LONGEST low_bound, high_bound;
 386   struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
 387   enum range_type range_type
 388     = (enum range_type) longest_to_int (exp->elts[pc].longconst);
 389
 390   *pos += 3;
 391
 392   if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
 393     low_bound = TYPE_LOW_BOUND (range);
 394   else
 395     low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 396
 397   if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
 398     high_bound = TYPE_HIGH_BOUND (range);
 399   else
 400     high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 401
 402   return value_slice (array, low_bound, high_bound - low_bound + 1);
 403 }
 404
 405
 406 /* Promote value ARG1 as appropriate before performing a unary operation
 407    on this argument.
 408    If the result is not appropriate for any particular language then it
 409    needs to patch this function.  */
 410
 411 void
 412 unop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
 413               struct value **arg1)
 414 {
 415   struct type *type1;
 416
 417   *arg1 = coerce_ref (*arg1);
 418   type1 = check_typedef (value_type (*arg1));
 419
 420   if (is_integral_type (type1))
 421     {
 422       switch (language->la_language)
 423         {
 424         default:
 425           /* Perform integral promotion for ANSI C/C++.
 426              If not appropropriate for any particular language
 427              it needs to modify this function.  */
 428           {
 429             struct type *builtin_int = builtin_type (gdbarch)->builtin_int;
 430
 431             if (TYPE_LENGTH (type1) < TYPE_LENGTH (builtin_int))
 432               *arg1 = value_cast (builtin_int, *arg1);
 433           }
 434           break;
 435         }
 436     }
 437 }
 438
 439 /* Promote values ARG1 and ARG2 as appropriate before performing a binary
 440    operation on those two operands.
 441    If the result is not appropriate for any particular language then it
 442    needs to patch this function.  */
 443
 444 void
 445 binop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
 446                struct value **arg1, struct value **arg2)
 447 {
 448   struct type *promoted_type = NULL;
 449   struct type *type1;
 450   struct type *type2;
 451
 452   *arg1 = coerce_ref (*arg1);
 453   *arg2 = coerce_ref (*arg2);
 454
 455   type1 = check_typedef (value_type (*arg1));
 456   type2 = check_typedef (value_type (*arg2));
 457
 458   if ((TYPE_CODE (type1) != TYPE_CODE_FLT
 459        && TYPE_CODE (type1) != TYPE_CODE_DECFLOAT
 460        && !is_integral_type (type1))
 461       || (TYPE_CODE (type2) != TYPE_CODE_FLT
 462           && TYPE_CODE (type2) != TYPE_CODE_DECFLOAT
 463           && !is_integral_type (type2)))
 464     return;
 465
 466   if (TYPE_CODE (type1) == TYPE_CODE_DECFLOAT
 467       || TYPE_CODE (type2) == TYPE_CODE_DECFLOAT)
 468     {
 469       /* No promotion required.  */
 470     }
 471   else if (TYPE_CODE (type1) == TYPE_CODE_FLT
 472            || TYPE_CODE (type2) == TYPE_CODE_FLT)
 473     {
 474       switch (language->la_language)
 475         {
 476         case language_c:
 477         case language_cplus:
 478         case language_asm:
 479         case language_objc:
 480         case language_opencl:
 481           /* No promotion required.  */
 482           break;
 483
 484         default:
 485           /* For other languages the result type is unchanged from gdb
 486              version 6.7 for backward compatibility.
 487              If either arg was long double, make sure that value is also long
 488              double.  Otherwise use double.  */
 489           if (TYPE_LENGTH (type1) * 8 > gdbarch_double_bit (gdbarch)
 490               || TYPE_LENGTH (type2) * 8 > gdbarch_double_bit (gdbarch))
 491             promoted_type = builtin_type (gdbarch)->builtin_long_double;
 492           else
 493             promoted_type = builtin_type (gdbarch)->builtin_double;
 494           break;
 495         }
 496     }
 497   else if (TYPE_CODE (type1) == TYPE_CODE_BOOL
 498            && TYPE_CODE (type2) == TYPE_CODE_BOOL)
 499     {
 500       /* No promotion required.  */
 501     }
 502   else
 503     /* Integral operations here.  */
 504     /* FIXME: Also mixed integral/booleans, with result an integer.  */
 505     {
 506       const struct builtin_type *builtin = builtin_type (gdbarch);
 507       unsigned int promoted_len1 = TYPE_LENGTH (type1);
 508       unsigned int promoted_len2 = TYPE_LENGTH (type2);
 509       int is_unsigned1 = TYPE_UNSIGNED (type1);
 510       int is_unsigned2 = TYPE_UNSIGNED (type2);
 511       unsigned int result_len;
 512       int unsigned_operation;
 513
 514       /* Determine type length and signedness after promotion for
 515          both operands.  */
 516       if (promoted_len1 < TYPE_LENGTH (builtin->builtin_int))
 517         {
 518           is_unsigned1 = 0;
 519           promoted_len1 = TYPE_LENGTH (builtin->builtin_int);
 520         }
 521       if (promoted_len2 < TYPE_LENGTH (builtin->builtin_int))
 522         {
 523           is_unsigned2 = 0;
 524           promoted_len2 = TYPE_LENGTH (builtin->builtin_int);
 525         }
 526
 527       if (promoted_len1 > promoted_len2)
 528         {
 529           unsigned_operation = is_unsigned1;
 530           result_len = promoted_len1;
 531         }
 532       else if (promoted_len2 > promoted_len1)
 533         {
 534           unsigned_operation = is_unsigned2;
 535           result_len = promoted_len2;
 536         }
 537       else
 538         {
 539           unsigned_operation = is_unsigned1 || is_unsigned2;
 540           result_len = promoted_len1;
 541         }
 542
 543       switch (language->la_language)
 544         {
 545         case language_c:
 546         case language_cplus:
 547         case language_asm:
 548         case language_objc:
 549           if (result_len <= TYPE_LENGTH (builtin->builtin_int))
 550             {
 551               promoted_type = (unsigned_operation
 552                                ? builtin->builtin_unsigned_int
 553                                : builtin->builtin_int);
 554             }
 555           else if (result_len <= TYPE_LENGTH (builtin->builtin_long))
 556             {
 557               promoted_type = (unsigned_operation
 558                                ? builtin->builtin_unsigned_long
 559                                : builtin->builtin_long);
 560             }
 561           else
 562             {
 563               promoted_type = (unsigned_operation
 564                                ? builtin->builtin_unsigned_long_long
 565                                : builtin->builtin_long_long);
 566             }
 567           break;
 568         case language_opencl:
 569           if (result_len <= TYPE_LENGTH (lookup_signed_typename
 570                                          (language, gdbarch, "int")))
 571             {
 572               promoted_type =
 573                 (unsigned_operation
 574                  ? lookup_unsigned_typename (language, gdbarch, "int")
 575                  : lookup_signed_typename (language, gdbarch, "int"));
 576             }
 577           else if (result_len <= TYPE_LENGTH (lookup_signed_typename
 578                                               (language, gdbarch, "long")))
 579             {
 580               promoted_type =
 581                 (unsigned_operation
 582                  ? lookup_unsigned_typename (language, gdbarch, "long")
 583                  : lookup_signed_typename (language, gdbarch,"long"));
 584             }
 585           break;
 586         default:
 587           /* For other languages the result type is unchanged from gdb
 588              version 6.7 for backward compatibility.
 589              If either arg was long long, make sure that value is also long
 590              long.  Otherwise use long.  */
 591           if (unsigned_operation)
 592             {
 593               if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
 594                 promoted_type = builtin->builtin_unsigned_long_long;
 595               else
 596                 promoted_type = builtin->builtin_unsigned_long;
 597             }
 598           else
 599             {
 600               if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
 601                 promoted_type = builtin->builtin_long_long;
 602               else
 603                 promoted_type = builtin->builtin_long;
 604             }
 605           break;
 606         }
 607     }
 608
 609   if (promoted_type)
 610     {
 611       /* Promote both operands to common type.  */
 612       *arg1 = value_cast (promoted_type, *arg1);
 613       *arg2 = value_cast (promoted_type, *arg2);
 614     }
 615 }
 616
 617 static int
 618 ptrmath_type_p (const struct language_defn *lang, struct type *type)
 619 {
 620   type = check_typedef (type);
 621   if (TYPE_IS_REFERENCE (type))
 622     type = TYPE_TARGET_TYPE (type);
 623
 624   switch (TYPE_CODE (type))
 625     {
 626     case TYPE_CODE_PTR:
 627     case TYPE_CODE_FUNC:
 628       return 1;
 629
 630     case TYPE_CODE_ARRAY:
 631       return TYPE_VECTOR (type) ? 0 : lang->c_style_arrays;
 632
 633     default:
 634       return 0;
 635     }
 636 }
 637
 638 /* Represents a fake method with the given parameter types.  This is
 639    used by the parser to construct a temporary "expected" type for
 640    method overload resolution.  FLAGS is used as instance flags of the
 641    new type, in order to be able to make the new type represent a
 642    const/volatile overload.  */
 643
 644 class fake_method
 645 {
 646 public:
 647   fake_method (type_instance_flags flags,
 648                int num_types, struct type **param_types);
 649   ~fake_method ();
 650
 651   /* The constructed type.  */
 652   struct type *type () { return &m_type; }
 653
 654 private:
 655   struct type m_type {};
 656   main_type m_main_type {};
 657 };
 658
 659 fake_method::fake_method (type_instance_flags flags,
 660                           int num_types, struct type **param_types)
 661 {
 662   struct type *type = &m_type;
 663
 664   TYPE_MAIN_TYPE (type) = &m_main_type;
 665   TYPE_LENGTH (type) = 1;
 666   TYPE_CODE (type) = TYPE_CODE_METHOD;
 667   TYPE_CHAIN (type) = type;
 668   TYPE_INSTANCE_FLAGS (type) = flags;
 669   if (num_types > 0)
 670     {
 671       if (param_types[num_types - 1] == NULL)
 672         {
 673           --num_types;
 674           TYPE_VARARGS (type) = 1;
 675         }
 676       else if (TYPE_CODE (check_typedef (param_types[num_types - 1]))
 677                == TYPE_CODE_VOID)
 678         {
 679           --num_types;
 680           /* Caller should have ensured this.  */
 681           gdb_assert (num_types == 0);
 682           TYPE_PROTOTYPED (type) = 1;
 683         }
 684     }
 685
 686   /* We don't use TYPE_ZALLOC here to allocate space as TYPE is owned by
 687      neither an objfile nor a gdbarch.  As a result we must manually
 688      allocate memory for auxiliary fields, and free the memory ourselves
 689      when we are done with it.  */
 690   TYPE_NFIELDS (type) = num_types;
 691   TYPE_FIELDS (type) = (struct field *)
 692     xzalloc (sizeof (struct field) * num_types);
 693
 694   while (num_types-- > 0)
 695     TYPE_FIELD_TYPE (type, num_types) = param_types[num_types];
 696 }
 697
 698 fake_method::~fake_method ()
 699 {
 700   xfree (TYPE_FIELDS (&m_type));
 701 }
 702
 703 /* Helper for evaluating an OP_VAR_VALUE.  */
 704
 705 value *
 706 evaluate_var_value (enum noside noside, const block *blk, symbol *var)
 707 {
 708   /* JYG: We used to just return value_zero of the symbol type if
 709      we're asked to avoid side effects.  Otherwise we return
 710      value_of_variable (...).  However I'm not sure if
 711      value_of_variable () has any side effect.  We need a full value
 712      object returned here for whatis_exp () to call evaluate_type ()
 713      and then pass the full value to value_rtti_target_type () if we
 714      are dealing with a pointer or reference to a base class and print
 715      object is on.  */
 716
 717   struct value *ret = NULL;
 718
 719   TRY
 720     {
 721       ret = value_of_variable (var, blk);
 722     }
 723
 724   CATCH (except, RETURN_MASK_ERROR)
 725     {
 726       if (noside != EVAL_AVOID_SIDE_EFFECTS)
 727         throw_exception (except);
 728
 729       ret = value_zero (SYMBOL_TYPE (var), not_lval);
 730     }
 731   END_CATCH
 732
 733   return ret;
 734 }
 735
 736 /* Helper for evaluating an OP_VAR_MSYM_VALUE.  */
 737
 738 value *
 739 evaluate_var_msym_value (enum noside noside,
 740                          struct objfile *objfile, minimal_symbol *msymbol)
 741 {
 742   CORE_ADDR address;
 743   type *the_type = find_minsym_type_and_address (msymbol, objfile, &address);
 744
 745   if (noside == EVAL_AVOID_SIDE_EFFECTS && !TYPE_GNU_IFUNC (the_type))
 746     return value_zero (the_type, not_lval);
 747   else
 748     return value_at_lazy (the_type, address);
 749 }
 750
 751 /* Helper for returning a value when handling EVAL_SKIP.  */
 752
 753 value *
 754 eval_skip_value (expression *exp)
 755 {
 756   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
 757 }
 758
 759 /* Evaluate a function call.  The function to be called is in
 760    ARGVEC[0] and the arguments passed to the function are in
 761    ARGVEC[1..NARGS].  FUNCTION_NAME is the name of the function, if
 762    known.  DEFAULT_RETURN_TYPE is used as the function's return type
 763    if the return type is unknown.  */
 764
 765 static value *
 766 eval_call (expression *exp, enum noside noside,
 767            int nargs, value **argvec,
 768            const char *function_name,
 769            type *default_return_type)
 770 {
 771   if (argvec[0] == NULL)
 772     error (_("Cannot evaluate function -- may be inlined"));
 773   if (noside == EVAL_AVOID_SIDE_EFFECTS)
 774     {
 775       /* If the return type doesn't look like a function type,
 776          call an error.  This can happen if somebody tries to turn
 777          a variable into a function call.  */
 778
 779       type *ftype = value_type (argvec[0]);
 780
 781       if (TYPE_CODE (ftype) == TYPE_CODE_INTERNAL_FUNCTION)
 782         {
 783           /* We don't know anything about what the internal
 784              function might return, but we have to return
 785              something.  */
 786           return value_zero (builtin_type (exp->gdbarch)->builtin_int,
 787                              not_lval);
 788         }
 789       else if (TYPE_CODE (ftype) == TYPE_CODE_XMETHOD)
 790         {
 791           type *return_type
 792             = result_type_of_xmethod (argvec[0],
 793                                       gdb::make_array_view (argvec + 1,
 794                                                             nargs));
 795
 796           if (return_type == NULL)
 797             error (_("Xmethod is missing return type."));
 798           return value_zero (return_type, not_lval);
 799         }
 800       else if (TYPE_CODE (ftype) == TYPE_CODE_FUNC
 801                || TYPE_CODE (ftype) == TYPE_CODE_METHOD)
 802         {
 803           if (TYPE_GNU_IFUNC (ftype))
 804             {
 805               CORE_ADDR address = value_address (argvec[0]);
 806               type *resolved_type = find_gnu_ifunc_target_type (address);
 807
 808               if (resolved_type != NULL)
 809                 ftype = resolved_type;
 810             }
 811
 812           type *return_type = TYPE_TARGET_TYPE (ftype);
 813
 814           if (return_type == NULL)
 815             return_type = default_return_type;
 816
 817           if (return_type == NULL)
 818             error_call_unknown_return_type (function_name);
 819
 820           return allocate_value (return_type);
 821         }
 822       else
 823         error (_("Expression of type other than "
 824                  "\"Function returning ...\" used as function"));
 825     }
 826   switch (TYPE_CODE (value_type (argvec[0])))
 827     {
 828     case TYPE_CODE_INTERNAL_FUNCTION:
 829       return call_internal_function (exp->gdbarch, exp->language_defn,
 830                                      argvec[0], nargs, argvec + 1);
 831     case TYPE_CODE_XMETHOD:
 832       return call_xmethod (argvec[0], gdb::make_array_view (argvec + 1, nargs));
 833     default:
 834       return call_function_by_hand (argvec[0], default_return_type,
 835                                     gdb::make_array_view (argvec + 1, nargs));
 836     }
 837 }
 838
 839 /* Helper for evaluating an OP_FUNCALL.  */
 840
 841 static value *
 842 evaluate_funcall (type *expect_type, expression *exp, int *pos,
 843                   enum noside noside)
 844 {
 845   int tem;
 846   int pc2 = 0;
 847   value *arg1 = NULL;
 848   value *arg2 = NULL;
 849   int save_pos1;
 850   symbol *function = NULL;
 851   char *function_name = NULL;
 852   const char *var_func_name = NULL;
 853
 854   int pc = (*pos);
 855   (*pos) += 2;
 856
 857   exp_opcode op = exp->elts[*pos].opcode;
 858   int nargs = longest_to_int (exp->elts[pc].longconst);
 859   /* Allocate arg vector, including space for the function to be
 860      called in argvec[0], a potential `this', and a terminating
 861      NULL.  */
 862   value **argvec = (value **) alloca (sizeof (value *) * (nargs + 3));
 863   if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 864     {
 865       /* First, evaluate the structure into arg2.  */
 866       pc2 = (*pos)++;
 867
 868       if (op == STRUCTOP_MEMBER)
 869         {
 870           arg2 = evaluate_subexp_for_address (exp, pos, noside);
 871         }
 872       else
 873         {
 874           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 875         }
 876
 877       /* If the function is a virtual function, then the aggregate
 878          value (providing the structure) plays its part by providing
 879          the vtable.  Otherwise, it is just along for the ride: call
 880          the function directly.  */
 881
 882       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 883
 884       type *a1_type = check_typedef (value_type (arg1));
 885       if (noside == EVAL_SKIP)
 886         tem = 1;  /* Set it to the right arg index so that all
 887                      arguments can also be skipped.  */
 888       else if (TYPE_CODE (a1_type) == TYPE_CODE_METHODPTR)
 889         {
 890           if (noside == EVAL_AVOID_SIDE_EFFECTS)
 891             arg1 = value_zero (TYPE_TARGET_TYPE (a1_type), not_lval);
 892           else
 893             arg1 = cplus_method_ptr_to_value (&arg2, arg1);
 894
 895           /* Now, say which argument to start evaluating from.  */
 896           nargs++;
 897           tem = 2;
 898           argvec[1] = arg2;
 899         }
 900       else if (TYPE_CODE (a1_type) == TYPE_CODE_MEMBERPTR)
 901         {
 902           struct type *type_ptr
 903             = lookup_pointer_type (TYPE_SELF_TYPE (a1_type));
 904           struct type *target_type_ptr
 905             = lookup_pointer_type (TYPE_TARGET_TYPE (a1_type));
 906
 907           /* Now, convert these values to an address.  */
 908           arg2 = value_cast (type_ptr, arg2);
 909
 910           long mem_offset = value_as_long (arg1);
 911
 912           arg1 = value_from_pointer (target_type_ptr,
 913                                      value_as_long (arg2) + mem_offset);
 914           arg1 = value_ind (arg1);
 915           tem = 1;
 916         }
 917       else
 918         error (_("Non-pointer-to-member value used in pointer-to-member "
 919                  "construct"));
 920     }
 921   else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 922     {
 923       /* Hair for method invocations.  */
 924       int tem2;
 925
 926       nargs++;
 927       /* First, evaluate the structure into arg2.  */
 928       pc2 = (*pos)++;
 929       tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
 930       *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
 931
 932       if (op == STRUCTOP_STRUCT)
 933         {
 934           /* If v is a variable in a register, and the user types
 935              v.method (), this will produce an error, because v has no
 936              address.
 937
 938              A possible way around this would be to allocate a copy of
 939              the variable on the stack, copy in the contents, call the
 940              function, and copy out the contents.  I.e. convert this
 941              from call by reference to call by copy-return (or
 942              whatever it's called).  However, this does not work
 943              because it is not the same: the method being called could
 944              stash a copy of the address, and then future uses through
 945              that address (after the method returns) would be expected
 946              to use the variable itself, not some copy of it.  */
 947           arg2 = evaluate_subexp_for_address (exp, pos, noside);
 948         }
 949       else
 950         {
 951           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 952
 953           /* Check to see if the operator '->' has been overloaded.
 954              If the operator has been overloaded replace arg2 with the
 955              value returned by the custom operator and continue
 956              evaluation.  */
 957           while (unop_user_defined_p (op, arg2))
 958             {
 959               struct value *value = NULL;
 960               TRY
 961                 {
 962                   value = value_x_unop (arg2, op, noside);
 963                 }
 964
 965               CATCH (except, RETURN_MASK_ERROR)
 966                 {
 967                   if (except.error == NOT_FOUND_ERROR)
 968                     break;
 969                   else
 970                     throw_exception (except);
 971                 }
 972               END_CATCH
 973
 974                 arg2 = value;
 975             }
 976         }
 977       /* Now, say which argument to start evaluating from.  */
 978       tem = 2;
 979     }
 980   else if (op == OP_SCOPE
 981            && overload_resolution
 982            && (exp->language_defn->la_language == language_cplus))
 983     {
 984       /* Unpack it locally so we can properly handle overload
 985          resolution.  */
 986       char *name;
 987       int local_tem;
 988
 989       pc2 = (*pos)++;
 990       local_tem = longest_to_int (exp->elts[pc2 + 2].longconst);
 991       (*pos) += 4 + BYTES_TO_EXP_ELEM (local_tem + 1);
 992       struct type *type = exp->elts[pc2 + 1].type;
 993       name = &exp->elts[pc2 + 3].string;
 994
 995       function = NULL;
 996       function_name = NULL;
 997       if (TYPE_CODE (type) == TYPE_CODE_NAMESPACE)
 998         {
 999           function = cp_lookup_symbol_namespace (TYPE_NAME (type),
1000                                                  name,
1001                                                  get_selected_block (0),
1002                                                  VAR_DOMAIN).symbol;
1003           if (function == NULL)
1004             error (_("No symbol \"%s\" in namespace \"%s\"."),
1005                    name, TYPE_NAME (type));
1006
1007           tem = 1;
1008           /* arg2 is left as NULL on purpose.  */
1009         }
1010       else
1011         {
1012           gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT
1013                       || TYPE_CODE (type) == TYPE_CODE_UNION);
1014           function_name = name;
1015
1016           /* We need a properly typed value for method lookup.  For
1017              static methods arg2 is otherwise unused.  */
1018           arg2 = value_zero (type, lval_memory);
1019           ++nargs;
1020           tem = 2;
1021         }
1022     }
1023   else if (op == OP_ADL_FUNC)
1024     {
1025       /* Save the function position and move pos so that the arguments
1026          can be evaluated.  */
1027       int func_name_len;
1028
1029       save_pos1 = *pos;
1030       tem = 1;
1031
1032       func_name_len = longest_to_int (exp->elts[save_pos1 + 3].longconst);
1033       (*pos) += 6 + BYTES_TO_EXP_ELEM (func_name_len + 1);
1034     }
1035   else
1036     {
1037       /* Non-method function call.  */
1038       save_pos1 = *pos;
1039       tem = 1;
1040
1041       /* If this is a C++ function wait until overload resolution.  */
1042       if (op == OP_VAR_VALUE
1043           && overload_resolution
1044           && (exp->language_defn->la_language == language_cplus))
1045         {
1046           (*pos) += 4; /* Skip the evaluation of the symbol.  */
1047           argvec[0] = NULL;
1048         }
1049       else
1050         {
1051           if (op == OP_VAR_MSYM_VALUE)
1052             {
1053               minimal_symbol *msym = exp->elts[*pos + 2].msymbol;
1054               var_func_name = MSYMBOL_PRINT_NAME (msym);
1055             }
1056           else if (op == OP_VAR_VALUE)
1057             {
1058               symbol *sym = exp->elts[*pos + 2].symbol;
1059               var_func_name = SYMBOL_PRINT_NAME (sym);
1060             }
1061
1062           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1063           type *type = value_type (argvec[0]);
1064           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1065             type = TYPE_TARGET_TYPE (type);
1066           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1067             {
1068               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1069                 {
1070                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type,
1071                                                                   tem - 1),
1072                                                  exp, pos, noside);
1073                 }
1074             }
1075         }
1076     }
1077
1078   /* Evaluate arguments (if not already done, e.g., namespace::func()
1079      and overload-resolution is off).  */
1080   for (; tem <= nargs; tem++)
1081     {
1082       /* Ensure that array expressions are coerced into pointer
1083          objects.  */
1084       argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1085     }
1086
1087   /* Signal end of arglist.  */
1088   argvec[tem] = 0;
1089
1090   if (noside == EVAL_SKIP)
1091     return eval_skip_value (exp);
1092
1093   if (op == OP_ADL_FUNC)
1094     {
1095       struct symbol *symp;
1096       char *func_name;
1097       int  name_len;
1098       int string_pc = save_pos1 + 3;
1099
1100       /* Extract the function name.  */
1101       name_len = longest_to_int (exp->elts[string_pc].longconst);
1102       func_name = (char *) alloca (name_len + 1);
1103       strcpy (func_name, &exp->elts[string_pc + 1].string);
1104
1105       find_overload_match (gdb::make_array_view (&argvec[1], nargs),
1106                            func_name,
1107                            NON_METHOD, /* not method */
1108                            NULL, NULL, /* pass NULL symbol since
1109                                           symbol is unknown */
1110                            NULL, &symp, NULL, 0, noside);
1111
1112       /* Now fix the expression being evaluated.  */
1113       exp->elts[save_pos1 + 2].symbol = symp;
1114       argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1115     }
1116
1117   if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR
1118       || (op == OP_SCOPE && function_name != NULL))
1119     {
1120       int static_memfuncp;
1121       char *tstr;
1122
1123       /* Method invocation: stuff "this" as first parameter.  If the
1124          method turns out to be static we undo this below.  */
1125       argvec[1] = arg2;
1126
1127       if (op != OP_SCOPE)
1128         {
1129           /* Name of method from expression.  */
1130           tstr = &exp->elts[pc2 + 2].string;
1131         }
1132       else
1133         tstr = function_name;
1134
1135       if (overload_resolution && (exp->language_defn->la_language
1136                                   == language_cplus))
1137         {
1138           /* Language is C++, do some overload resolution before
1139              evaluation.  */
1140           struct value *valp = NULL;
1141
1142           (void) find_overload_match (gdb::make_array_view (&argvec[1], nargs),
1143                                       tstr,
1144                                       METHOD, /* method */
1145                                       &arg2,  /* the object */
1146                                       NULL, &valp, NULL,
1147                                       &static_memfuncp, 0, noside);
1148
1149           if (op == OP_SCOPE && !static_memfuncp)
1150             {
1151               /* For the time being, we don't handle this.  */
1152               error (_("Call to overloaded function %s requires "
1153                        "`this' pointer"),
1154                      function_name);
1155             }
1156           argvec[1] = arg2;     /* the ``this'' pointer */
1157           argvec[0] = valp;     /* Use the method found after overload
1158                                    resolution.  */
1159         }
1160       else
1161         /* Non-C++ case -- or no overload resolution.  */
1162         {
1163           struct value *temp = arg2;
1164
1165           argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1166                                         &static_memfuncp,
1167                                         op == STRUCTOP_STRUCT
1168                                         ? "structure" : "structure pointer");
1169           /* value_struct_elt updates temp with the correct value of
1170              the ``this'' pointer if necessary, so modify argvec[1] to
1171              reflect any ``this'' changes.  */
1172           arg2
1173             = value_from_longest (lookup_pointer_type(value_type (temp)),
1174                                   value_address (temp)
1175                                   + value_embedded_offset (temp));
1176           argvec[1] = arg2;     /* the ``this'' pointer */
1177         }
1178
1179       /* Take out `this' if needed.  */
1180       if (static_memfuncp)
1181         {
1182           argvec[1] = argvec[0];
1183           nargs--;
1184           argvec++;
1185         }
1186     }
1187   else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1188     {
1189       /* Pointer to member.  argvec[1] is already set up.  */
1190       argvec[0] = arg1;
1191     }
1192   else if (op == OP_VAR_VALUE || (op == OP_SCOPE && function != NULL))
1193     {
1194       /* Non-member function being called.  */
1195       /* fn: This can only be done for C++ functions.  A C-style
1196          function in a C++ program, for instance, does not have the
1197          fields that are expected here.  */
1198
1199       if (overload_resolution && (exp->language_defn->la_language
1200                                   == language_cplus))
1201         {
1202           /* Language is C++, do some overload resolution before
1203              evaluation.  */
1204           struct symbol *symp;
1205           int no_adl = 0;
1206
1207           /* If a scope has been specified disable ADL.  */
1208           if (op == OP_SCOPE)
1209             no_adl = 1;
1210
1211           if (op == OP_VAR_VALUE)
1212             function = exp->elts[save_pos1+2].symbol;
1213
1214           (void) find_overload_match (gdb::make_array_view (&argvec[1], nargs),
1215                                       NULL,        /* no need for name */
1216                                       NON_METHOD,  /* not method */
1217                                       NULL, function, /* the function */
1218                                       NULL, &symp, NULL, no_adl, noside);
1219
1220           if (op == OP_VAR_VALUE)
1221             {
1222               /* Now fix the expression being evaluated.  */
1223               exp->elts[save_pos1+2].symbol = symp;
1224               argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1,
1225                                                          noside);
1226             }
1227           else
1228             argvec[0] = value_of_variable (symp, get_selected_block (0));
1229         }
1230       else
1231         {
1232           /* Not C++, or no overload resolution allowed.  */
1233           /* Nothing to be done; argvec already correctly set up.  */
1234         }
1235     }
1236   else
1237     {
1238       /* It is probably a C-style function.  */
1239       /* Nothing to be done; argvec already correctly set up.  */
1240     }
1241
1242   return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
1243 }
1244
1245 /* Helper for skipping all the arguments in an undetermined argument list.
1246    This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
1247    case of evaluate_subexp_standard as multiple, but not all, code paths
1248    require a generic skip.  */
1249
1250 static void
1251 skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
1252                            enum noside noside)
1253 {
1254   for (int i = 0; i < nargs; ++i)
1255     evaluate_subexp (NULL_TYPE, exp, pos, noside);
1256 }
1257
1258 struct value *
1259 evaluate_subexp_standard (struct type *expect_type,
1260                           struct expression *exp, int *pos,
1261                           enum noside noside)
1262 {
1263   enum exp_opcode op;
1264   int tem, tem2, tem3;
1265   int pc, oldpos;
1266   struct value *arg1 = NULL;
1267   struct value *arg2 = NULL;
1268   struct value *arg3;
1269   struct type *type;
1270   int nargs;
1271   struct value **argvec;
1272   int code;
1273   int ix;
1274   long mem_offset;
1275   struct type **arg_types;
1276
1277   pc = (*pos)++;
1278   op = exp->elts[pc].opcode;
1279
1280   switch (op)
1281     {
1282     case OP_SCOPE:
1283       tem = longest_to_int (exp->elts[pc + 2].longconst);
1284       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
1285       if (noside == EVAL_SKIP)
1286         return eval_skip_value (exp);
1287       arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
1288                                   &exp->elts[pc + 3].string,
1289                                   expect_type, 0, noside);
1290       if (arg1 == NULL)
1291         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
1292       return arg1;
1293
1294     case OP_LONG:
1295       (*pos) += 3;
1296       return value_from_longest (exp->elts[pc + 1].type,
1297                                  exp->elts[pc + 2].longconst);
1298
1299     case OP_FLOAT:
1300       (*pos) += 3;
1301       return value_from_contents (exp->elts[pc + 1].type,
1302                                   exp->elts[pc + 2].floatconst);
1303
1304     case OP_ADL_FUNC:
1305     case OP_VAR_VALUE:
1306       {
1307         (*pos) += 3;
1308         symbol *var = exp->elts[pc + 2].symbol;
1309         if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ERROR)
1310           error_unknown_type (SYMBOL_PRINT_NAME (var));
1311         if (noside != EVAL_SKIP)
1312             return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
1313         else
1314           {
1315             /* Return a dummy value of the correct type when skipping, so
1316                that parent functions know what is to be skipped.  */
1317             return allocate_value (SYMBOL_TYPE (var));
1318           }
1319       }
1320
1321     case OP_VAR_MSYM_VALUE:
1322       {
1323         (*pos) += 3;
1324
1325         minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
1326         value *val = evaluate_var_msym_value (noside,
1327                                               exp->elts[pc + 1].objfile,
1328                                               msymbol);
1329
1330         type = value_type (val);
1331         if (TYPE_CODE (type) == TYPE_CODE_ERROR
1332             && (noside != EVAL_AVOID_SIDE_EFFECTS || pc != 0))
1333           error_unknown_type (MSYMBOL_PRINT_NAME (msymbol));
1334         return val;
1335       }
1336
1337     case OP_VAR_ENTRY_VALUE:
1338       (*pos) += 2;
1339       if (noside == EVAL_SKIP)
1340         return eval_skip_value (exp);
1341
1342       {
1343         struct symbol *sym = exp->elts[pc + 1].symbol;
1344         struct frame_info *frame;
1345
1346         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1347           return value_zero (SYMBOL_TYPE (sym), not_lval);
1348
1349         if (SYMBOL_COMPUTED_OPS (sym) == NULL
1350             || SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry == NULL)
1351           error (_("Symbol \"%s\" does not have any specific entry value"),
1352                  SYMBOL_PRINT_NAME (sym));
1353
1354         frame = get_selected_frame (NULL);
1355         return SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry (sym, frame);
1356       }
1357
1358     case OP_FUNC_STATIC_VAR:
1359       tem = longest_to_int (exp->elts[pc + 1].longconst);
1360       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1361       if (noside == EVAL_SKIP)
1362         return eval_skip_value (exp);
1363
1364       {
1365         value *func = evaluate_subexp_standard (NULL, exp, pos, noside);
1366         CORE_ADDR addr = value_address (func);
1367
1368         const block *blk = block_for_pc (addr);
1369         const char *var = &exp->elts[pc + 2].string;
1370
1371         struct block_symbol sym = lookup_symbol (var, blk, VAR_DOMAIN, NULL);
1372
1373         if (sym.symbol == NULL)
1374           error (_("No symbol \"%s\" in specified context."), var);
1375
1376         return evaluate_var_value (noside, sym.block, sym.symbol);
1377       }
1378
1379     case OP_LAST:
1380       (*pos) += 2;
1381       return
1382         access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
1383
1384     case OP_REGISTER:
1385       {
1386         const char *name = &exp->elts[pc + 2].string;
1387         int regno;
1388         struct value *val;
1389
1390         (*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
1391         regno = user_reg_map_name_to_regnum (exp->gdbarch,
1392                                              name, strlen (name));
1393         if (regno == -1)
1394           error (_("Register $%s not available."), name);
1395
1396         /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
1397            a value with the appropriate register type.  Unfortunately,
1398            we don't have easy access to the type of user registers.
1399            So for these registers, we fetch the register value regardless
1400            of the evaluation mode.  */
1401         if (noside == EVAL_AVOID_SIDE_EFFECTS
1402             && regno < gdbarch_num_cooked_regs (exp->gdbarch))
1403           val = value_zero (register_type (exp->gdbarch, regno), not_lval);
1404         else
1405           val = value_of_register (regno, get_selected_frame (NULL));
1406         if (val == NULL)
1407           error (_("Value of register %s not available."), name);
1408         else
1409           return val;
1410       }
1411     case OP_BOOL:
1412       (*pos) += 2;
1413       type = language_bool_type (exp->language_defn, exp->gdbarch);
1414       return value_from_longest (type, exp->elts[pc + 1].longconst);
1415
1416     case OP_INTERNALVAR:
1417       (*pos) += 2;
1418       return value_of_internalvar (exp->gdbarch,
1419                                    exp->elts[pc + 1].internalvar);
1420
1421     case OP_STRING:
1422       tem = longest_to_int (exp->elts[pc + 1].longconst);
1423       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1424       if (noside == EVAL_SKIP)
1425         return eval_skip_value (exp);
1426       type = language_string_char_type (exp->language_defn, exp->gdbarch);
1427       return value_string (&exp->elts[pc + 2].string, tem, type);
1428
1429     case OP_OBJC_NSSTRING:              /* Objective C Foundation Class
1430                                            NSString constant.  */
1431       tem = longest_to_int (exp->elts[pc + 1].longconst);
1432       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1433       if (noside == EVAL_SKIP)
1434         return eval_skip_value (exp);
1435       return value_nsstring (exp->gdbarch, &exp->elts[pc + 2].string, tem + 1);
1436
1437     case OP_ARRAY:
1438       (*pos) += 3;
1439       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
1440       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
1441       nargs = tem3 - tem2 + 1;
1442       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
1443
1444       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1445           && TYPE_CODE (type) == TYPE_CODE_STRUCT)
1446         {
1447           struct value *rec = allocate_value (expect_type);
1448
1449           memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
1450           return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
1451         }
1452
1453       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1454           && TYPE_CODE (type) == TYPE_CODE_ARRAY)
1455         {
1456           struct type *range_type = TYPE_INDEX_TYPE (type);
1457           struct type *element_type = TYPE_TARGET_TYPE (type);
1458           struct value *array = allocate_value (expect_type);
1459           int element_size = TYPE_LENGTH (check_typedef (element_type));
1460           LONGEST low_bound, high_bound, index;
1461
1462           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
1463             {
1464               low_bound = 0;
1465               high_bound = (TYPE_LENGTH (type) / element_size) - 1;
1466             }
1467           index = low_bound;
1468           memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
1469           for (tem = nargs; --nargs >= 0;)
1470             {
1471               struct value *element;
1472               int index_pc = 0;
1473
1474               element = evaluate_subexp (element_type, exp, pos, noside);
1475               if (value_type (element) != element_type)
1476                 element = value_cast (element_type, element);
1477               if (index_pc)
1478                 {
1479                   int continue_pc = *pos;
1480
1481                   *pos = index_pc;
1482                   index = init_array_element (array, element, exp, pos, noside,
1483                                               low_bound, high_bound);
1484                   *pos = continue_pc;
1485                 }
1486               else
1487                 {
1488                   if (index > high_bound)
1489                     /* To avoid memory corruption.  */
1490                     error (_("Too many array elements"));
1491                   memcpy (value_contents_raw (array)
1492                           + (index - low_bound) * element_size,
1493                           value_contents (element),
1494                           element_size);
1495                 }
1496               index++;
1497             }
1498           return array;
1499         }
1500
1501       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1502           && TYPE_CODE (type) == TYPE_CODE_SET)
1503         {
1504           struct value *set = allocate_value (expect_type);
1505           gdb_byte *valaddr = value_contents_raw (set);
1506           struct type *element_type = TYPE_INDEX_TYPE (type);
1507           struct type *check_type = element_type;
1508           LONGEST low_bound, high_bound;
1509
1510           /* Get targettype of elementtype.  */
1511           while (TYPE_CODE (check_type) == TYPE_CODE_RANGE
1512                  || TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
1513             check_type = TYPE_TARGET_TYPE (check_type);
1514
1515           if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
1516             error (_("(power)set type with unknown size"));
1517           memset (valaddr, '\0', TYPE_LENGTH (type));
1518           for (tem = 0; tem < nargs; tem++)
1519             {
1520               LONGEST range_low, range_high;
1521               struct type *range_low_type, *range_high_type;
1522               struct value *elem_val;
1523
1524               elem_val = evaluate_subexp (element_type, exp, pos, noside);
1525               range_low_type = range_high_type = value_type (elem_val);
1526               range_low = range_high = value_as_long (elem_val);
1527
1528               /* Check types of elements to avoid mixture of elements from
1529                  different types. Also check if type of element is "compatible"
1530                  with element type of powerset.  */
1531               if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
1532                 range_low_type = TYPE_TARGET_TYPE (range_low_type);
1533               if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
1534                 range_high_type = TYPE_TARGET_TYPE (range_high_type);
1535               if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type))
1536                   || (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM
1537                       && (range_low_type != range_high_type)))
1538                 /* different element modes.  */
1539                 error (_("POWERSET tuple elements of different mode"));
1540               if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type))
1541                   || (TYPE_CODE (check_type) == TYPE_CODE_ENUM
1542                       && range_low_type != check_type))
1543                 error (_("incompatible POWERSET tuple elements"));
1544               if (range_low > range_high)
1545                 {
1546                   warning (_("empty POWERSET tuple range"));
1547                   continue;
1548                 }
1549               if (range_low < low_bound || range_high > high_bound)
1550                 error (_("POWERSET tuple element out of range"));
1551               range_low -= low_bound;
1552               range_high -= low_bound;
1553               for (; range_low <= range_high; range_low++)
1554                 {
1555                   int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
1556
1557                   if (gdbarch_bits_big_endian (exp->gdbarch))
1558                     bit_index = TARGET_CHAR_BIT - 1 - bit_index;
1559                   valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
1560                     |= 1 << bit_index;
1561                 }
1562             }
1563           return set;
1564         }
1565
1566       argvec = XALLOCAVEC (struct value *, nargs);
1567       for (tem = 0; tem < nargs; tem++)
1568         {
1569           /* Ensure that array expressions are coerced into pointer
1570              objects.  */
1571           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1572         }
1573       if (noside == EVAL_SKIP)
1574         return eval_skip_value (exp);
1575       return value_array (tem2, tem3, argvec);
1576
1577     case TERNOP_SLICE:
1578       {
1579         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1580         int lowbound
1581           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1582         int upper
1583           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1584
1585         if (noside == EVAL_SKIP)
1586           return eval_skip_value (exp);
1587         return value_slice (array, lowbound, upper - lowbound + 1);
1588       }
1589
1590     case TERNOP_COND:
1591       /* Skip third and second args to evaluate the first one.  */
1592       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1593       if (value_logical_not (arg1))
1594         {
1595           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1596           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1597         }
1598       else
1599         {
1600           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1601           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1602           return arg2;
1603         }
1604
1605     case OP_OBJC_SELECTOR:
1606       {                         /* Objective C @selector operator.  */
1607         char *sel = &exp->elts[pc + 2].string;
1608         int len = longest_to_int (exp->elts[pc + 1].longconst);
1609         struct type *selector_type;
1610
1611         (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1612         if (noside == EVAL_SKIP)
1613           return eval_skip_value (exp);
1614
1615         if (sel[len] != 0)
1616           sel[len] = 0;         /* Make sure it's terminated.  */
1617
1618         selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1619         return value_from_longest (selector_type,
1620                                    lookup_child_selector (exp->gdbarch, sel));
1621       }
1622
1623     case OP_OBJC_MSGCALL:
1624       {                         /* Objective C message (method) call.  */
1625
1626         CORE_ADDR responds_selector = 0;
1627         CORE_ADDR method_selector = 0;
1628
1629         CORE_ADDR selector = 0;
1630
1631         int struct_return = 0;
1632         enum noside sub_no_side = EVAL_NORMAL;
1633
1634         struct value *msg_send = NULL;
1635         struct value *msg_send_stret = NULL;
1636         int gnu_runtime = 0;
1637
1638         struct value *target = NULL;
1639         struct value *method = NULL;
1640         struct value *called_method = NULL;
1641
1642         struct type *selector_type = NULL;
1643         struct type *long_type;
1644
1645         struct value *ret = NULL;
1646         CORE_ADDR addr = 0;
1647
1648         selector = exp->elts[pc + 1].longconst;
1649         nargs = exp->elts[pc + 2].longconst;
1650         argvec = XALLOCAVEC (struct value *, nargs + 5);
1651
1652         (*pos) += 3;
1653
1654         long_type = builtin_type (exp->gdbarch)->builtin_long;
1655         selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1656
1657         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1658           sub_no_side = EVAL_NORMAL;
1659         else
1660           sub_no_side = noside;
1661
1662         target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1663
1664         if (value_as_long (target) == 0)
1665           return value_from_longest (long_type, 0);
1666
1667         if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0).minsym)
1668           gnu_runtime = 1;
1669
1670         /* Find the method dispatch (Apple runtime) or method lookup
1671            (GNU runtime) function for Objective-C.  These will be used
1672            to lookup the symbol information for the method.  If we
1673            can't find any symbol information, then we'll use these to
1674            call the method, otherwise we can call the method
1675            directly.  The msg_send_stret function is used in the special
1676            case of a method that returns a structure (Apple runtime
1677            only).  */
1678         if (gnu_runtime)
1679           {
1680             type = selector_type;
1681
1682             type = lookup_function_type (type);
1683             type = lookup_pointer_type (type);
1684             type = lookup_function_type (type);
1685             type = lookup_pointer_type (type);
1686
1687             msg_send = find_function_in_inferior ("objc_msg_lookup", NULL);
1688             msg_send_stret
1689               = find_function_in_inferior ("objc_msg_lookup", NULL);
1690
1691             msg_send = value_from_pointer (type, value_as_address (msg_send));
1692             msg_send_stret = value_from_pointer (type,
1693                                         value_as_address (msg_send_stret));
1694           }
1695         else
1696           {
1697             msg_send = find_function_in_inferior ("objc_msgSend", NULL);
1698             /* Special dispatcher for methods returning structs.  */
1699             msg_send_stret
1700               = find_function_in_inferior ("objc_msgSend_stret", NULL);
1701           }
1702
1703         /* Verify the target object responds to this method.  The
1704            standard top-level 'Object' class uses a different name for
1705            the verification method than the non-standard, but more
1706            often used, 'NSObject' class.  Make sure we check for both.  */
1707
1708         responds_selector
1709           = lookup_child_selector (exp->gdbarch, "respondsToSelector:");
1710         if (responds_selector == 0)
1711           responds_selector
1712             = lookup_child_selector (exp->gdbarch, "respondsTo:");
1713
1714         if (responds_selector == 0)
1715           error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1716
1717         method_selector
1718           = lookup_child_selector (exp->gdbarch, "methodForSelector:");
1719         if (method_selector == 0)
1720           method_selector
1721             = lookup_child_selector (exp->gdbarch, "methodFor:");
1722
1723         if (method_selector == 0)
1724           error (_("no 'methodFor:' or 'methodForSelector:' method"));
1725
1726         /* Call the verification method, to make sure that the target
1727          class implements the desired method.  */
1728
1729         argvec[0] = msg_send;
1730         argvec[1] = target;
1731         argvec[2] = value_from_longest (long_type, responds_selector);
1732         argvec[3] = value_from_longest (long_type, selector);
1733         argvec[4] = 0;
1734
1735         ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1736         if (gnu_runtime)
1737           {
1738             /* Function objc_msg_lookup returns a pointer.  */
1739             argvec[0] = ret;
1740             ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1741           }
1742         if (value_as_long (ret) == 0)
1743           error (_("Target does not respond to this message selector."));
1744
1745         /* Call "methodForSelector:" method, to get the address of a
1746            function method that implements this selector for this
1747            class.  If we can find a symbol at that address, then we
1748            know the return type, parameter types etc.  (that's a good
1749            thing).  */
1750
1751         argvec[0] = msg_send;
1752         argvec[1] = target;
1753         argvec[2] = value_from_longest (long_type, method_selector);
1754         argvec[3] = value_from_longest (long_type, selector);
1755         argvec[4] = 0;
1756
1757         ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1758         if (gnu_runtime)
1759           {
1760             argvec[0] = ret;
1761             ret = call_function_by_hand (argvec[0], NULL, {argvec + 1, 3});
1762           }
1763
1764         /* ret should now be the selector.  */
1765
1766         addr = value_as_long (ret);
1767         if (addr)
1768           {
1769             struct symbol *sym = NULL;
1770
1771             /* The address might point to a function descriptor;
1772                resolve it to the actual code address instead.  */
1773             addr = gdbarch_convert_from_func_ptr_addr (exp->gdbarch, addr,
1774                                                        current_top_target ());
1775
1776             /* Is it a high_level symbol?  */
1777             sym = find_pc_function (addr);
1778             if (sym != NULL)
1779               method = value_of_variable (sym, 0);
1780           }
1781
1782         /* If we found a method with symbol information, check to see
1783            if it returns a struct.  Otherwise assume it doesn't.  */
1784
1785         if (method)
1786           {
1787             CORE_ADDR funaddr;
1788             struct type *val_type;
1789
1790             funaddr = find_function_addr (method, &val_type);
1791
1792             block_for_pc (funaddr);
1793
1794             val_type = check_typedef (val_type);
1795
1796             if ((val_type == NULL)
1797                 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1798               {
1799                 if (expect_type != NULL)
1800                   val_type = expect_type;
1801               }
1802
1803             struct_return = using_struct_return (exp->gdbarch, method,
1804                                                  val_type);
1805           }
1806         else if (expect_type != NULL)
1807           {
1808             struct_return = using_struct_return (exp->gdbarch, NULL,
1809                                                  check_typedef (expect_type));
1810           }
1811
1812         /* Found a function symbol.  Now we will substitute its
1813            value in place of the message dispatcher (obj_msgSend),
1814            so that we call the method directly instead of thru
1815            the dispatcher.  The main reason for doing this is that
1816            we can now evaluate the return value and parameter values
1817            according to their known data types, in case we need to
1818            do things like promotion, dereferencing, special handling
1819            of structs and doubles, etc.
1820
1821            We want to use the type signature of 'method', but still
1822            jump to objc_msgSend() or objc_msgSend_stret() to better
1823            mimic the behavior of the runtime.  */
1824
1825         if (method)
1826           {
1827             if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1828               error (_("method address has symbol information "
1829                        "with non-function type; skipping"));
1830
1831             /* Create a function pointer of the appropriate type, and
1832                replace its value with the value of msg_send or
1833                msg_send_stret.  We must use a pointer here, as
1834                msg_send and msg_send_stret are of pointer type, and
1835                the representation may be different on systems that use
1836                function descriptors.  */
1837             if (struct_return)
1838               called_method
1839                 = value_from_pointer (lookup_pointer_type (value_type (method)),
1840                                       value_as_address (msg_send_stret));
1841             else
1842               called_method
1843                 = value_from_pointer (lookup_pointer_type (value_type (method)),
1844                                       value_as_address (msg_send));
1845           }
1846         else
1847           {
1848             if (struct_return)
1849               called_method = msg_send_stret;
1850             else
1851               called_method = msg_send;
1852           }
1853
1854         if (noside == EVAL_SKIP)
1855           return eval_skip_value (exp);
1856
1857         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1858           {
1859             /* If the return type doesn't look like a function type,
1860                call an error.  This can happen if somebody tries to
1861                turn a variable into a function call.  This is here
1862                because people often want to call, eg, strcmp, which
1863                gdb doesn't know is a function.  If gdb isn't asked for
1864                it's opinion (ie. through "whatis"), it won't offer
1865                it.  */
1866
1867             struct type *callee_type = value_type (called_method);
1868
1869             if (callee_type && TYPE_CODE (callee_type) == TYPE_CODE_PTR)
1870               callee_type = TYPE_TARGET_TYPE (callee_type);
1871             callee_type = TYPE_TARGET_TYPE (callee_type);
1872
1873             if (callee_type)
1874             {
1875               if ((TYPE_CODE (callee_type) == TYPE_CODE_ERROR) && expect_type)
1876                 return allocate_value (expect_type);
1877               else
1878                 return allocate_value (callee_type);
1879             }
1880             else
1881               error (_("Expression of type other than "
1882                        "\"method returning ...\" used as a method"));
1883           }
1884
1885         /* Now depending on whether we found a symbol for the method,
1886            we will either call the runtime dispatcher or the method
1887            directly.  */
1888
1889         argvec[0] = called_method;
1890         argvec[1] = target;
1891         argvec[2] = value_from_longest (long_type, selector);
1892         /* User-supplied arguments.  */
1893         for (tem = 0; tem < nargs; tem++)
1894           argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1895         argvec[tem + 3] = 0;
1896
1897         auto call_args = gdb::make_array_view (argvec + 1, nargs + 2);
1898
1899         if (gnu_runtime && (method != NULL))
1900           {
1901             /* Function objc_msg_lookup returns a pointer.  */
1902             deprecated_set_value_type (argvec[0],
1903                                        lookup_pointer_type (lookup_function_type (value_type (argvec[0]))));
1904             argvec[0] = call_function_by_hand (argvec[0], NULL, call_args);
1905           }
1906
1907         return call_function_by_hand (argvec[0], NULL, call_args);
1908       }
1909       break;
1910
1911     case OP_FUNCALL:
1912       return evaluate_funcall (expect_type, exp, pos, noside);
1913
1914     case OP_F77_UNDETERMINED_ARGLIST:
1915
1916       /* Remember that in F77, functions, substring ops and
1917          array subscript operations cannot be disambiguated
1918          at parse time.  We have made all array subscript operations,
1919          substring operations as well as function calls  come here
1920          and we now have to discover what the heck this thing actually was.
1921          If it is a function, we process just as if we got an OP_FUNCALL.  */
1922
1923       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1924       (*pos) += 2;
1925
1926       /* First determine the type code we are dealing with.  */
1927       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1928       type = check_typedef (value_type (arg1));
1929       code = TYPE_CODE (type);
1930
1931       if (code == TYPE_CODE_PTR)
1932         {
1933           /* Fortran always passes variable to subroutines as pointer.
1934              So we need to look into its target type to see if it is
1935              array, string or function.  If it is, we need to switch
1936              to the target value the original one points to.  */
1937           struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1938
1939           if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1940               || TYPE_CODE (target_type) == TYPE_CODE_STRING
1941               || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1942             {
1943               arg1 = value_ind (arg1);
1944               type = check_typedef (value_type (arg1));
1945               code = TYPE_CODE (type);
1946             }
1947         }
1948
1949       switch (code)
1950         {
1951         case TYPE_CODE_ARRAY:
1952           if (exp->elts[*pos].opcode == OP_RANGE)
1953             return value_f90_subarray (arg1, exp, pos, noside);
1954           else
1955             {
1956               if (noside == EVAL_SKIP)
1957                 {
1958                   skip_undetermined_arglist (nargs, exp, pos, noside);
1959                   /* Return the dummy value with the correct type.  */
1960                   return arg1;
1961                 }
1962               goto multi_f77_subscript;
1963             }
1964
1965         case TYPE_CODE_STRING:
1966           if (exp->elts[*pos].opcode == OP_RANGE)
1967             return value_f90_subarray (arg1, exp, pos, noside);
1968           else
1969             {
1970               if (noside == EVAL_SKIP)
1971                 {
1972                   skip_undetermined_arglist (nargs, exp, pos, noside);
1973                   /* Return the dummy value with the correct type.  */
1974                   return arg1;
1975                 }
1976               arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1977               return value_subscript (arg1, value_as_long (arg2));
1978             }
1979
1980         case TYPE_CODE_PTR:
1981         case TYPE_CODE_FUNC:
1982           /* It's a function call.  */
1983           /* Allocate arg vector, including space for the function to be
1984              called in argvec[0] and a terminating NULL.  */
1985           argvec = (struct value **)
1986             alloca (sizeof (struct value *) * (nargs + 2));
1987           argvec[0] = arg1;
1988           tem = 1;
1989           for (; tem <= nargs; tem++)
1990             {
1991               argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1992               /* Arguments in Fortran are passed by address.  Coerce the
1993                  arguments here rather than in value_arg_coerce as otherwise
1994                  the call to malloc to place the non-lvalue parameters in
1995                  target memory is hit by this Fortran specific logic.  This
1996                  results in malloc being called with a pointer to an integer
1997                  followed by an attempt to malloc the arguments to malloc in
1998                  target memory.  Infinite recursion ensues.  */
1999               bool is_artificial =
2000                 TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
2001               argvec[tem] = fortran_argument_convert (argvec[tem],
2002                                                       is_artificial);
2003             }
2004           argvec[tem] = 0;      /* signal end of arglist */
2005           if (noside == EVAL_SKIP)
2006             return eval_skip_value (exp);
2007           return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
2008
2009         default:
2010           error (_("Cannot perform substring on this type"));
2011         }
2012
2013     case OP_COMPLEX:
2014       /* We have a complex number, There should be 2 floating
2015          point numbers that compose it.  */
2016       (*pos) += 2;
2017       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2018       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2019
2020       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
2021
2022     case STRUCTOP_STRUCT:
2023       tem = longest_to_int (exp->elts[pc + 1].longconst);
2024       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
2025       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2026       if (noside == EVAL_SKIP)
2027         return eval_skip_value (exp);
2028       arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
2029                                NULL, "structure");
2030       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2031         arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
2032       return arg3;
2033
2034     case STRUCTOP_PTR:
2035       tem = longest_to_int (exp->elts[pc + 1].longconst);
2036       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
2037       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2038       if (noside == EVAL_SKIP)
2039         return eval_skip_value (exp);
2040
2041       /* Check to see if operator '->' has been overloaded.  If so replace
2042          arg1 with the value returned by evaluating operator->().  */
2043       while (unop_user_defined_p (op, arg1))
2044         {
2045           struct value *value = NULL;
2046           TRY
2047             {
2048               value = value_x_unop (arg1, op, noside);
2049             }
2050
2051           CATCH (except, RETURN_MASK_ERROR)
2052             {
2053               if (except.error == NOT_FOUND_ERROR)
2054                 break;
2055               else
2056                 throw_exception (except);
2057             }
2058           END_CATCH
2059
2060           arg1 = value;
2061         }
2062
2063       /* JYG: if print object is on we need to replace the base type
2064          with rtti type in order to continue on with successful
2065          lookup of member / method only available in the rtti type.  */
2066       {
2067         struct type *arg_type = value_type (arg1);
2068         struct type *real_type;
2069         int full, using_enc;
2070         LONGEST top;
2071         struct value_print_options opts;
2072
2073         get_user_print_options (&opts);
2074         if (opts.objectprint && TYPE_TARGET_TYPE (arg_type)
2075             && (TYPE_CODE (TYPE_TARGET_TYPE (arg_type)) == TYPE_CODE_STRUCT))
2076           {
2077             real_type = value_rtti_indirect_type (arg1, &full, &top,
2078                                                   &using_enc);
2079             if (real_type)
2080                 arg1 = value_cast (real_type, arg1);
2081           }
2082       }
2083
2084       arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
2085                                NULL, "structure pointer");
2086       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2087         arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
2088       return arg3;
2089
2090     case STRUCTOP_MEMBER:
2091     case STRUCTOP_MPTR:
2092       if (op == STRUCTOP_MEMBER)
2093         arg1 = evaluate_subexp_for_address (exp, pos, noside);
2094       else
2095         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2096
2097       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2098
2099       if (noside == EVAL_SKIP)
2100         return eval_skip_value (exp);
2101
2102       type = check_typedef (value_type (arg2));
2103       switch (TYPE_CODE (type))
2104         {
2105         case TYPE_CODE_METHODPTR:
2106           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2107             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
2108           else
2109             {
2110               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
2111               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
2112               return value_ind (arg2);
2113             }
2114
2115         case TYPE_CODE_MEMBERPTR:
2116           /* Now, convert these values to an address.  */
2117           arg1 = value_cast_pointers (lookup_pointer_type (TYPE_SELF_TYPE (type)),
2118                                       arg1, 1);
2119
2120           mem_offset = value_as_long (arg2);
2121
2122           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2123                                      value_as_long (arg1) + mem_offset);
2124           return value_ind (arg3);
2125
2126         default:
2127           error (_("non-pointer-to-member value used "
2128                    "in pointer-to-member construct"));
2129         }
2130
2131     case TYPE_INSTANCE:
2132       {
2133         type_instance_flags flags
2134           = (type_instance_flag_value) longest_to_int (exp->elts[pc + 1].longconst);
2135         nargs = longest_to_int (exp->elts[pc + 2].longconst);
2136         arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
2137         for (ix = 0; ix < nargs; ++ix)
2138           arg_types[ix] = exp->elts[pc + 2 + ix + 1].type;
2139
2140         fake_method fake_expect_type (flags, nargs, arg_types);
2141         *(pos) += 4 + nargs;
2142         return evaluate_subexp_standard (fake_expect_type.type (), exp, pos,
2143                                          noside);
2144       }
2145
2146     case BINOP_CONCAT:
2147       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2148       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2149       if (noside == EVAL_SKIP)
2150         return eval_skip_value (exp);
2151       if (binop_user_defined_p (op, arg1, arg2))
2152         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2153       else
2154         return value_concat (arg1, arg2);
2155
2156     case BINOP_ASSIGN:
2157       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2158       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2159
2160       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2161         return arg1;
2162       if (binop_user_defined_p (op, arg1, arg2))
2163         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2164       else
2165         return value_assign (arg1, arg2);
2166
2167     case BINOP_ASSIGN_MODIFY:
2168       (*pos) += 2;
2169       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2170       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2171       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2172         return arg1;
2173       op = exp->elts[pc + 1].opcode;
2174       if (binop_user_defined_p (op, arg1, arg2))
2175         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
2176       else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
2177                                                   value_type (arg1))
2178                && is_integral_type (value_type (arg2)))
2179         arg2 = value_ptradd (arg1, value_as_long (arg2));
2180       else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
2181                                                   value_type (arg1))
2182                && is_integral_type (value_type (arg2)))
2183         arg2 = value_ptradd (arg1, - value_as_long (arg2));
2184       else
2185         {
2186           struct value *tmp = arg1;
2187
2188           /* For shift and integer exponentiation operations,
2189              only promote the first argument.  */
2190           if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2191               && is_integral_type (value_type (arg2)))
2192             unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2193           else
2194             binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2195
2196           arg2 = value_binop (tmp, arg2, op);
2197         }
2198       return value_assign (arg1, arg2);
2199
2200     case BINOP_ADD:
2201       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2202       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2203       if (noside == EVAL_SKIP)
2204         return eval_skip_value (exp);
2205       if (binop_user_defined_p (op, arg1, arg2))
2206         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2207       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2208                && is_integral_type (value_type (arg2)))
2209         return value_ptradd (arg1, value_as_long (arg2));
2210       else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2211                && is_integral_type (value_type (arg1)))
2212         return value_ptradd (arg2, value_as_long (arg1));
2213       else
2214         {
2215           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2216           return value_binop (arg1, arg2, BINOP_ADD);
2217         }
2218
2219     case BINOP_SUB:
2220       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2221       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2222       if (noside == EVAL_SKIP)
2223         return eval_skip_value (exp);
2224       if (binop_user_defined_p (op, arg1, arg2))
2225         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2226       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2227                && ptrmath_type_p (exp->language_defn, value_type (arg2)))
2228         {
2229           /* FIXME -- should be ptrdiff_t */
2230           type = builtin_type (exp->gdbarch)->builtin_long;
2231           return value_from_longest (type, value_ptrdiff (arg1, arg2));
2232         }
2233       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2234                && is_integral_type (value_type (arg2)))
2235         return value_ptradd (arg1, - value_as_long (arg2));
2236       else
2237         {
2238           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2239           return value_binop (arg1, arg2, BINOP_SUB);
2240         }
2241
2242     case BINOP_EXP:
2243     case BINOP_MUL:
2244     case BINOP_DIV:
2245     case BINOP_INTDIV:
2246     case BINOP_REM:
2247     case BINOP_MOD:
2248     case BINOP_LSH:
2249     case BINOP_RSH:
2250     case BINOP_BITWISE_AND:
2251     case BINOP_BITWISE_IOR:
2252     case BINOP_BITWISE_XOR:
2253       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2254       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2255       if (noside == EVAL_SKIP)
2256         return eval_skip_value (exp);
2257       if (binop_user_defined_p (op, arg1, arg2))
2258         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2259       else
2260         {
2261           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2262              fudge arg2 to avoid division-by-zero, the caller is
2263              (theoretically) only looking for the type of the result.  */
2264           if (noside == EVAL_AVOID_SIDE_EFFECTS
2265               /* ??? Do we really want to test for BINOP_MOD here?
2266                  The implementation of value_binop gives it a well-defined
2267                  value.  */
2268               && (op == BINOP_DIV
2269                   || op == BINOP_INTDIV
2270                   || op == BINOP_REM
2271                   || op == BINOP_MOD)
2272               && value_logical_not (arg2))
2273             {
2274               struct value *v_one, *retval;
2275
2276               v_one = value_one (value_type (arg2));
2277               binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
2278               retval = value_binop (arg1, v_one, op);
2279               return retval;
2280             }
2281           else
2282             {
2283               /* For shift and integer exponentiation operations,
2284                  only promote the first argument.  */
2285               if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2286                   && is_integral_type (value_type (arg2)))
2287                 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2288               else
2289                 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2290
2291               return value_binop (arg1, arg2, op);
2292             }
2293         }
2294
2295     case BINOP_SUBSCRIPT:
2296       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2297       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2298       if (noside == EVAL_SKIP)
2299         return eval_skip_value (exp);
2300       if (binop_user_defined_p (op, arg1, arg2))
2301         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2302       else
2303         {
2304           /* If the user attempts to subscript something that is not an
2305              array or pointer type (like a plain int variable for example),
2306              then report this as an error.  */
2307
2308           arg1 = coerce_ref (arg1);
2309           type = check_typedef (value_type (arg1));
2310           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
2311               && TYPE_CODE (type) != TYPE_CODE_PTR)
2312             {
2313               if (TYPE_NAME (type))
2314                 error (_("cannot subscript something of type `%s'"),
2315                        TYPE_NAME (type));
2316               else
2317                 error (_("cannot subscript requested type"));
2318             }
2319
2320           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2321             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2322           else
2323             return value_subscript (arg1, value_as_long (arg2));
2324         }
2325     case MULTI_SUBSCRIPT:
2326       (*pos) += 2;
2327       nargs = longest_to_int (exp->elts[pc + 1].longconst);
2328       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2329       while (nargs-- > 0)
2330         {
2331           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2332           /* FIXME:  EVAL_SKIP handling may not be correct.  */
2333           if (noside == EVAL_SKIP)
2334             {
2335               if (nargs > 0)
2336                 continue;
2337               return eval_skip_value (exp);
2338             }
2339           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct.  */
2340           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2341             {
2342               /* If the user attempts to subscript something that has no target
2343                  type (like a plain int variable for example), then report this
2344                  as an error.  */
2345
2346               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
2347               if (type != NULL)
2348                 {
2349                   arg1 = value_zero (type, VALUE_LVAL (arg1));
2350                   noside = EVAL_SKIP;
2351                   continue;
2352                 }
2353               else
2354                 {
2355                   error (_("cannot subscript something of type `%s'"),
2356                          TYPE_NAME (value_type (arg1)));
2357                 }
2358             }
2359
2360           if (binop_user_defined_p (op, arg1, arg2))
2361             {
2362               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2363             }
2364           else
2365             {
2366               arg1 = coerce_ref (arg1);
2367               type = check_typedef (value_type (arg1));
2368
2369               switch (TYPE_CODE (type))
2370                 {
2371                 case TYPE_CODE_PTR:
2372                 case TYPE_CODE_ARRAY:
2373                 case TYPE_CODE_STRING:
2374                   arg1 = value_subscript (arg1, value_as_long (arg2));
2375                   break;
2376
2377                 default:
2378                   if (TYPE_NAME (type))
2379                     error (_("cannot subscript something of type `%s'"),
2380                            TYPE_NAME (type));
2381                   else
2382                     error (_("cannot subscript requested type"));
2383                 }
2384             }
2385         }
2386       return (arg1);
2387
2388     multi_f77_subscript:
2389       {
2390         LONGEST subscript_array[MAX_FORTRAN_DIMS];
2391         int ndimensions = 1, i;
2392         struct value *array = arg1;
2393
2394         if (nargs > MAX_FORTRAN_DIMS)
2395           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2396
2397         ndimensions = calc_f77_array_dims (type);
2398
2399         if (nargs != ndimensions)
2400           error (_("Wrong number of subscripts"));
2401
2402         gdb_assert (nargs > 0);
2403
2404         /* Now that we know we have a legal array subscript expression
2405            let us actually find out where this element exists in the array.  */
2406
2407         /* Take array indices left to right.  */
2408         for (i = 0; i < nargs; i++)
2409           {
2410             /* Evaluate each subscript; it must be a legal integer in F77.  */
2411             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2412
2413             /* Fill in the subscript array.  */
2414
2415             subscript_array[i] = value_as_long (arg2);
2416           }
2417
2418         /* Internal type of array is arranged right to left.  */
2419         for (i = nargs; i > 0; i--)
2420           {
2421             struct type *array_type = check_typedef (value_type (array));
2422             LONGEST index = subscript_array[i - 1];
2423
2424             array = value_subscripted_rvalue (array, index,
2425                                               f77_get_lowerbound (array_type));
2426           }
2427
2428         return array;
2429       }
2430
2431     case BINOP_LOGICAL_AND:
2432       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2433       if (noside == EVAL_SKIP)
2434         {
2435           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2436           return eval_skip_value (exp);
2437         }
2438
2439       oldpos = *pos;
2440       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2441       *pos = oldpos;
2442
2443       if (binop_user_defined_p (op, arg1, arg2))
2444         {
2445           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2446           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2447         }
2448       else
2449         {
2450           tem = value_logical_not (arg1);
2451           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2452                                   (tem ? EVAL_SKIP : noside));
2453           type = language_bool_type (exp->language_defn, exp->gdbarch);
2454           return value_from_longest (type,
2455                              (LONGEST) (!tem && !value_logical_not (arg2)));
2456         }
2457
2458     case BINOP_LOGICAL_OR:
2459       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2460       if (noside == EVAL_SKIP)
2461         {
2462           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2463           return eval_skip_value (exp);
2464         }
2465
2466       oldpos = *pos;
2467       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2468       *pos = oldpos;
2469
2470       if (binop_user_defined_p (op, arg1, arg2))
2471         {
2472           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2473           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2474         }
2475       else
2476         {
2477           tem = value_logical_not (arg1);
2478           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2479                                   (!tem ? EVAL_SKIP : noside));
2480           type = language_bool_type (exp->language_defn, exp->gdbarch);
2481           return value_from_longest (type,
2482                              (LONGEST) (!tem || !value_logical_not (arg2)));
2483         }
2484
2485     case BINOP_EQUAL:
2486       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2487       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2488       if (noside == EVAL_SKIP)
2489         return eval_skip_value (exp);
2490       if (binop_user_defined_p (op, arg1, arg2))
2491         {
2492           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2493         }
2494       else
2495         {
2496           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2497           tem = value_equal (arg1, arg2);
2498           type = language_bool_type (exp->language_defn, exp->gdbarch);
2499           return value_from_longest (type, (LONGEST) tem);
2500         }
2501
2502     case BINOP_NOTEQUAL:
2503       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2504       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2505       if (noside == EVAL_SKIP)
2506         return eval_skip_value (exp);
2507       if (binop_user_defined_p (op, arg1, arg2))
2508         {
2509           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2510         }
2511       else
2512         {
2513           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2514           tem = value_equal (arg1, arg2);
2515           type = language_bool_type (exp->language_defn, exp->gdbarch);
2516           return value_from_longest (type, (LONGEST) ! tem);
2517         }
2518
2519     case BINOP_LESS:
2520       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2521       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2522       if (noside == EVAL_SKIP)
2523         return eval_skip_value (exp);
2524       if (binop_user_defined_p (op, arg1, arg2))
2525         {
2526           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2527         }
2528       else
2529         {
2530           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2531           tem = value_less (arg1, arg2);
2532           type = language_bool_type (exp->language_defn, exp->gdbarch);
2533           return value_from_longest (type, (LONGEST) tem);
2534         }
2535
2536     case BINOP_GTR:
2537       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2538       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2539       if (noside == EVAL_SKIP)
2540         return eval_skip_value (exp);
2541       if (binop_user_defined_p (op, arg1, arg2))
2542         {
2543           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2544         }
2545       else
2546         {
2547           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2548           tem = value_less (arg2, arg1);
2549           type = language_bool_type (exp->language_defn, exp->gdbarch);
2550           return value_from_longest (type, (LONGEST) tem);
2551         }
2552
2553     case BINOP_GEQ:
2554       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2555       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2556       if (noside == EVAL_SKIP)
2557         return eval_skip_value (exp);
2558       if (binop_user_defined_p (op, arg1, arg2))
2559         {
2560           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2561         }
2562       else
2563         {
2564           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2565           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2566           type = language_bool_type (exp->language_defn, exp->gdbarch);
2567           return value_from_longest (type, (LONGEST) tem);
2568         }
2569
2570     case BINOP_LEQ:
2571       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2572       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2573       if (noside == EVAL_SKIP)
2574         return eval_skip_value (exp);
2575       if (binop_user_defined_p (op, arg1, arg2))
2576         {
2577           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2578         }
2579       else
2580         {
2581           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2582           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2583           type = language_bool_type (exp->language_defn, exp->gdbarch);
2584           return value_from_longest (type, (LONGEST) tem);
2585         }
2586
2587     case BINOP_REPEAT:
2588       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2589       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2590       if (noside == EVAL_SKIP)
2591         return eval_skip_value (exp);
2592       type = check_typedef (value_type (arg2));
2593       if (TYPE_CODE (type) != TYPE_CODE_INT
2594           && TYPE_CODE (type) != TYPE_CODE_ENUM)
2595         error (_("Non-integral right operand for \"@\" operator."));
2596       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2597         {
2598           return allocate_repeat_value (value_type (arg1),
2599                                      longest_to_int (value_as_long (arg2)));
2600         }
2601       else
2602         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2603
2604     case BINOP_COMMA:
2605       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2606       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2607
2608     case UNOP_PLUS:
2609       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2610       if (noside == EVAL_SKIP)
2611         return eval_skip_value (exp);
2612       if (unop_user_defined_p (op, arg1))
2613         return value_x_unop (arg1, op, noside);
2614       else
2615         {
2616           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2617           return value_pos (arg1);
2618         }
2619
2620     case UNOP_NEG:
2621       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2622       if (noside == EVAL_SKIP)
2623         return eval_skip_value (exp);
2624       if (unop_user_defined_p (op, arg1))
2625         return value_x_unop (arg1, op, noside);
2626       else
2627         {
2628           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2629           return value_neg (arg1);
2630         }
2631
2632     case UNOP_COMPLEMENT:
2633       /* C++: check for and handle destructor names.  */
2634
2635       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2636       if (noside == EVAL_SKIP)
2637         return eval_skip_value (exp);
2638       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2639         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2640       else
2641         {
2642           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2643           return value_complement (arg1);
2644         }
2645
2646     case UNOP_LOGICAL_NOT:
2647       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2648       if (noside == EVAL_SKIP)
2649         return eval_skip_value (exp);
2650       if (unop_user_defined_p (op, arg1))
2651         return value_x_unop (arg1, op, noside);
2652       else
2653         {
2654           type = language_bool_type (exp->language_defn, exp->gdbarch);
2655           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2656         }
2657
2658     case UNOP_IND:
2659       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2660         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2661       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2662       type = check_typedef (value_type (arg1));
2663       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2664           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2665         error (_("Attempt to dereference pointer "
2666                  "to member without an object"));
2667       if (noside == EVAL_SKIP)
2668         return eval_skip_value (exp);
2669       if (unop_user_defined_p (op, arg1))
2670         return value_x_unop (arg1, op, noside);
2671       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2672         {
2673           type = check_typedef (value_type (arg1));
2674           if (TYPE_CODE (type) == TYPE_CODE_PTR
2675               || TYPE_IS_REFERENCE (type)
2676           /* In C you can dereference an array to get the 1st elt.  */
2677               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2678             )
2679             return value_zero (TYPE_TARGET_TYPE (type),
2680                                lval_memory);
2681           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2682             /* GDB allows dereferencing an int.  */
2683             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2684                                lval_memory);
2685           else
2686             error (_("Attempt to take contents of a non-pointer value."));
2687         }
2688
2689       /* Allow * on an integer so we can cast it to whatever we want.
2690          This returns an int, which seems like the most C-like thing to
2691          do.  "long long" variables are rare enough that
2692          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2693       if (TYPE_CODE (type) == TYPE_CODE_INT)
2694         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2695                               (CORE_ADDR) value_as_address (arg1));
2696       return value_ind (arg1);
2697
2698     case UNOP_ADDR:
2699       /* C++: check for and handle pointer to members.  */
2700
2701       if (noside == EVAL_SKIP)
2702         {
2703           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2704           return eval_skip_value (exp);
2705         }
2706       else
2707         {
2708           struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2709                                                                noside);
2710
2711           return retvalp;
2712         }
2713
2714     case UNOP_SIZEOF:
2715       if (noside == EVAL_SKIP)
2716         {
2717           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2718           return eval_skip_value (exp);
2719         }
2720       return evaluate_subexp_for_sizeof (exp, pos, noside);
2721
2722     case UNOP_ALIGNOF:
2723       {
2724         type = value_type (evaluate_subexp (NULL_TYPE, exp, pos,
2725                                             EVAL_AVOID_SIDE_EFFECTS));
2726         /* FIXME: This should be size_t.  */
2727         struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
2728         ULONGEST align = type_align (type);
2729         if (align == 0)
2730           error (_("could not determine alignment of type"));
2731         return value_from_longest (size_type, align);
2732       }
2733
2734     case UNOP_CAST:
2735       (*pos) += 2;
2736       type = exp->elts[pc + 1].type;
2737       return evaluate_subexp_for_cast (exp, pos, noside, type);
2738
2739     case UNOP_CAST_TYPE:
2740       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2741       type = value_type (arg1);
2742       return evaluate_subexp_for_cast (exp, pos, noside, type);
2743
2744     case UNOP_DYNAMIC_CAST:
2745       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2746       type = value_type (arg1);
2747       arg1 = evaluate_subexp (type, exp, pos, noside);
2748       if (noside == EVAL_SKIP)
2749         return eval_skip_value (exp);
2750       return value_dynamic_cast (type, arg1);
2751
2752     case UNOP_REINTERPRET_CAST:
2753       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2754       type = value_type (arg1);
2755       arg1 = evaluate_subexp (type, exp, pos, noside);
2756       if (noside == EVAL_SKIP)
2757         return eval_skip_value (exp);
2758       return value_reinterpret_cast (type, arg1);
2759
2760     case UNOP_MEMVAL:
2761       (*pos) += 2;
2762       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2763       if (noside == EVAL_SKIP)
2764         return eval_skip_value (exp);
2765       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2766         return value_zero (exp->elts[pc + 1].type, lval_memory);
2767       else
2768         return value_at_lazy (exp->elts[pc + 1].type,
2769                               value_as_address (arg1));
2770
2771     case UNOP_MEMVAL_TYPE:
2772       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2773       type = value_type (arg1);
2774       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2775       if (noside == EVAL_SKIP)
2776         return eval_skip_value (exp);
2777       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2778         return value_zero (type, lval_memory);
2779       else
2780         return value_at_lazy (type, value_as_address (arg1));
2781
2782     case UNOP_PREINCREMENT:
2783       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2784       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2785         return arg1;
2786       else if (unop_user_defined_p (op, arg1))
2787         {
2788           return value_x_unop (arg1, op, noside);
2789         }
2790       else
2791         {
2792           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2793             arg2 = value_ptradd (arg1, 1);
2794           else
2795             {
2796               struct value *tmp = arg1;
2797
2798               arg2 = value_one (value_type (arg1));
2799               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2800               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2801             }
2802
2803           return value_assign (arg1, arg2);
2804         }
2805
2806     case UNOP_PREDECREMENT:
2807       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2808       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2809         return arg1;
2810       else if (unop_user_defined_p (op, arg1))
2811         {
2812           return value_x_unop (arg1, op, noside);
2813         }
2814       else
2815         {
2816           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2817             arg2 = value_ptradd (arg1, -1);
2818           else
2819             {
2820               struct value *tmp = arg1;
2821
2822               arg2 = value_one (value_type (arg1));
2823               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2824               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2825             }
2826
2827           return value_assign (arg1, arg2);
2828         }
2829
2830     case UNOP_POSTINCREMENT:
2831       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2832       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2833         return arg1;
2834       else if (unop_user_defined_p (op, arg1))
2835         {
2836           return value_x_unop (arg1, op, noside);
2837         }
2838       else
2839         {
2840           arg3 = value_non_lval (arg1);
2841
2842           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2843             arg2 = value_ptradd (arg1, 1);
2844           else
2845             {
2846               struct value *tmp = arg1;
2847
2848               arg2 = value_one (value_type (arg1));
2849               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2850               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2851             }
2852
2853           value_assign (arg1, arg2);
2854           return arg3;
2855         }
2856
2857     case UNOP_POSTDECREMENT:
2858       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2859       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2860         return arg1;
2861       else if (unop_user_defined_p (op, arg1))
2862         {
2863           return value_x_unop (arg1, op, noside);
2864         }
2865       else
2866         {
2867           arg3 = value_non_lval (arg1);
2868
2869           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2870             arg2 = value_ptradd (arg1, -1);
2871           else
2872             {
2873               struct value *tmp = arg1;
2874
2875               arg2 = value_one (value_type (arg1));
2876               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2877               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2878             }
2879
2880           value_assign (arg1, arg2);
2881           return arg3;
2882         }
2883
2884     case OP_THIS:
2885       (*pos) += 1;
2886       return value_of_this (exp->language_defn);
2887
2888     case OP_TYPE:
2889       /* The value is not supposed to be used.  This is here to make it
2890          easier to accommodate expressions that contain types.  */
2891       (*pos) += 2;
2892       if (noside == EVAL_SKIP)
2893         return eval_skip_value (exp);
2894       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2895         return allocate_value (exp->elts[pc + 1].type);
2896       else
2897         error (_("Attempt to use a type name as an expression"));
2898
2899     case OP_TYPEOF:
2900     case OP_DECLTYPE:
2901       if (noside == EVAL_SKIP)
2902         {
2903           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2904           return eval_skip_value (exp);
2905         }
2906       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2907         {
2908           enum exp_opcode sub_op = exp->elts[*pos].opcode;
2909           struct value *result;
2910
2911           result = evaluate_subexp (NULL_TYPE, exp, pos,
2912                                     EVAL_AVOID_SIDE_EFFECTS);
2913
2914           /* 'decltype' has special semantics for lvalues.  */
2915           if (op == OP_DECLTYPE
2916               && (sub_op == BINOP_SUBSCRIPT
2917                   || sub_op == STRUCTOP_MEMBER
2918                   || sub_op == STRUCTOP_MPTR
2919                   || sub_op == UNOP_IND
2920                   || sub_op == STRUCTOP_STRUCT
2921                   || sub_op == STRUCTOP_PTR
2922                   || sub_op == OP_SCOPE))
2923             {
2924               type = value_type (result);
2925
2926               if (!TYPE_IS_REFERENCE (type))
2927                 {
2928                   type = lookup_lvalue_reference_type (type);
2929                   result = allocate_value (type);
2930                 }
2931             }
2932
2933           return result;
2934         }
2935       else
2936         error (_("Attempt to use a type as an expression"));
2937
2938     case OP_TYPEID:
2939       {
2940         struct value *result;
2941         enum exp_opcode sub_op = exp->elts[*pos].opcode;
2942
2943         if (sub_op == OP_TYPE || sub_op == OP_DECLTYPE || sub_op == OP_TYPEOF)
2944           result = evaluate_subexp (NULL_TYPE, exp, pos,
2945                                     EVAL_AVOID_SIDE_EFFECTS);
2946         else
2947           result = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2948
2949         if (noside != EVAL_NORMAL)
2950           return allocate_value (cplus_typeid_type (exp->gdbarch));
2951
2952         return cplus_typeid (result);
2953       }
2954
2955     default:
2956       /* Removing this case and compiling with gcc -Wall reveals that
2957          a lot of cases are hitting this case.  Some of these should
2958          probably be removed from expression.h; others are legitimate
2959          expressions which are (apparently) not fully implemented.
2960
2961          If there are any cases landing here which mean a user error,
2962          then they should be separate cases, with more descriptive
2963          error messages.  */
2964
2965       error (_("GDB does not (yet) know how to "
2966                "evaluate that kind of expression"));
2967     }
2968
2969   gdb_assert_not_reached ("missed return?");
2970 }
2971 \f
2972 /* Evaluate a subexpression of EXP, at index *POS,
2973    and return the address of that subexpression.
2974    Advance *POS over the subexpression.
2975    If the subexpression isn't an lvalue, get an error.
2976    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2977    then only the type of the result need be correct.  */
2978
2979 static struct value *
2980 evaluate_subexp_for_address (struct expression *exp, int *pos,
2981                              enum noside noside)
2982 {
2983   enum exp_opcode op;
2984   int pc;
2985   struct symbol *var;
2986   struct value *x;
2987   int tem;
2988
2989   pc = (*pos);
2990   op = exp->elts[pc].opcode;
2991
2992   switch (op)
2993     {
2994     case UNOP_IND:
2995       (*pos)++;
2996       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2997
2998       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2999       if (unop_user_defined_p (op, x))
3000         {
3001           x = value_x_unop (x, op, noside);
3002           goto default_case_after_eval;
3003         }
3004
3005       return coerce_array (x);
3006
3007     case UNOP_MEMVAL:
3008       (*pos) += 3;
3009       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
3010                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
3011
3012     case UNOP_MEMVAL_TYPE:
3013       {
3014         struct type *type;
3015
3016         (*pos) += 1;
3017         x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3018         type = value_type (x);
3019         return value_cast (lookup_pointer_type (type),
3020                            evaluate_subexp (NULL_TYPE, exp, pos, noside));
3021       }
3022
3023     case OP_VAR_VALUE:
3024       var = exp->elts[pc + 2].symbol;
3025
3026       /* C++: The "address" of a reference should yield the address
3027        * of the object pointed to.  Let value_addr() deal with it.  */
3028       if (TYPE_IS_REFERENCE (SYMBOL_TYPE (var)))
3029         goto default_case;
3030
3031       (*pos) += 4;
3032       if (noside == EVAL_AVOID_SIDE_EFFECTS)
3033         {
3034           struct type *type =
3035             lookup_pointer_type (SYMBOL_TYPE (var));
3036           enum address_class sym_class = SYMBOL_CLASS (var);
3037
3038           if (sym_class == LOC_CONST
3039               || sym_class == LOC_CONST_BYTES
3040               || sym_class == LOC_REGISTER)
3041             error (_("Attempt to take address of register or constant."));
3042
3043           return
3044             value_zero (type, not_lval);
3045         }
3046       else
3047         return address_of_variable (var, exp->elts[pc + 1].block);
3048
3049     case OP_VAR_MSYM_VALUE:
3050       {
3051         (*pos) += 4;
3052
3053         value *val = evaluate_var_msym_value (noside,
3054                                               exp->elts[pc + 1].objfile,
3055                                               exp->elts[pc + 2].msymbol);
3056         if (noside == EVAL_AVOID_SIDE_EFFECTS)
3057           {
3058             struct type *type = lookup_pointer_type (value_type (val));
3059             return value_zero (type, not_lval);
3060           }
3061         else
3062           return value_addr (val);
3063       }
3064
3065     case OP_SCOPE:
3066       tem = longest_to_int (exp->elts[pc + 2].longconst);
3067       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
3068       x = value_aggregate_elt (exp->elts[pc + 1].type,
3069                                &exp->elts[pc + 3].string,
3070                                NULL, 1, noside);
3071       if (x == NULL)
3072         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
3073       return x;
3074
3075     default:
3076     default_case:
3077       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
3078     default_case_after_eval:
3079       if (noside == EVAL_AVOID_SIDE_EFFECTS)
3080         {
3081           struct type *type = check_typedef (value_type (x));
3082
3083           if (TYPE_IS_REFERENCE (type))
3084             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3085                                not_lval);
3086           else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
3087             return value_zero (lookup_pointer_type (value_type (x)),
3088                                not_lval);
3089           else
3090             error (_("Attempt to take address of "
3091                      "value not located in memory."));
3092         }
3093       return value_addr (x);
3094     }
3095 }
3096
3097 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
3098    When used in contexts where arrays will be coerced anyway, this is
3099    equivalent to `evaluate_subexp' but much faster because it avoids
3100    actually fetching array contents (perhaps obsolete now that we have
3101    value_lazy()).
3102
3103    Note that we currently only do the coercion for C expressions, where
3104    arrays are zero based and the coercion is correct.  For other languages,
3105    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
3106    to decide if coercion is appropriate.  */
3107
3108 struct value *
3109 evaluate_subexp_with_coercion (struct expression *exp,
3110                                int *pos, enum noside noside)
3111 {
3112   enum exp_opcode op;
3113   int pc;
3114   struct value *val;
3115   struct symbol *var;
3116   struct type *type;
3117
3118   pc = (*pos);
3119   op = exp->elts[pc].opcode;
3120
3121   switch (op)
3122     {
3123     case OP_VAR_VALUE:
3124       var = exp->elts[pc + 2].symbol;
3125       type = check_typedef (SYMBOL_TYPE (var));
3126       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
3127           && !TYPE_VECTOR (type)
3128           && CAST_IS_CONVERSION (exp->language_defn))
3129         {
3130           (*pos) += 4;
3131           val = address_of_variable (var, exp->elts[pc + 1].block);
3132           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3133                              val);
3134         }
3135       /* FALLTHROUGH */
3136
3137     default:
3138       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
3139     }
3140 }
3141
3142 /* Evaluate a subexpression of EXP, at index *POS,
3143    and return a value for the size of that subexpression.
3144    Advance *POS over the subexpression.  If NOSIDE is EVAL_NORMAL
3145    we allow side-effects on the operand if its type is a variable
3146    length array.   */
3147
3148 static struct value *
3149 evaluate_subexp_for_sizeof (struct expression *exp, int *pos,
3150                             enum noside noside)
3151 {
3152   /* FIXME: This should be size_t.  */
3153   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3154   enum exp_opcode op;
3155   int pc;
3156   struct type *type;
3157   struct value *val;
3158
3159   pc = (*pos);
3160   op = exp->elts[pc].opcode;
3161
3162   switch (op)
3163     {
3164       /* This case is handled specially
3165          so that we avoid creating a value for the result type.
3166          If the result type is very big, it's desirable not to
3167          create a value unnecessarily.  */
3168     case UNOP_IND:
3169       (*pos)++;
3170       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3171       type = check_typedef (value_type (val));
3172       if (TYPE_CODE (type) != TYPE_CODE_PTR
3173           && !TYPE_IS_REFERENCE (type)
3174           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3175         error (_("Attempt to take contents of a non-pointer value."));
3176       type = TYPE_TARGET_TYPE (type);
3177       if (is_dynamic_type (type))
3178         type = value_type (value_ind (val));
3179       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3180
3181     case UNOP_MEMVAL:
3182       (*pos) += 3;
3183       type = exp->elts[pc + 1].type;
3184       break;
3185
3186     case UNOP_MEMVAL_TYPE:
3187       (*pos) += 1;
3188       val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3189       type = value_type (val);
3190       break;
3191
3192     case OP_VAR_VALUE:
3193       type = SYMBOL_TYPE (exp->elts[pc + 2].symbol);
3194       if (is_dynamic_type (type))
3195         {
3196           val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3197           type = value_type (val);
3198           if (TYPE_CODE (type) == TYPE_CODE_ARRAY
3199               && is_dynamic_type (TYPE_INDEX_TYPE (type))
3200               && TYPE_HIGH_BOUND_UNDEFINED (TYPE_INDEX_TYPE (type)))
3201             return allocate_optimized_out_value (size_type);
3202         }
3203       else
3204         (*pos) += 4;
3205       break;
3206
3207     case OP_VAR_MSYM_VALUE:
3208       {
3209         (*pos) += 4;
3210
3211         minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
3212         value *mval = evaluate_var_msym_value (noside,
3213                                                exp->elts[pc + 1].objfile,
3214                                                msymbol);
3215
3216         type = value_type (mval);
3217         if (TYPE_CODE (type) == TYPE_CODE_ERROR)
3218           error_unknown_type (MSYMBOL_PRINT_NAME (msymbol));
3219
3220         return value_from_longest (size_type, TYPE_LENGTH (type));
3221       }
3222       break;
3223
3224       /* Deal with the special case if NOSIDE is EVAL_NORMAL and the resulting
3225          type of the subscript is a variable length array type. In this case we
3226          must re-evaluate the right hand side of the subcription to allow
3227          side-effects. */
3228     case BINOP_SUBSCRIPT:
3229       if (noside == EVAL_NORMAL)
3230         {
3231           int npc = (*pos) + 1;
3232
3233           val = evaluate_subexp (NULL_TYPE, exp, &npc, EVAL_AVOID_SIDE_EFFECTS);
3234           type = check_typedef (value_type (val));
3235           if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3236             {
3237               type = check_typedef (TYPE_TARGET_TYPE (type));
3238               if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3239                 {
3240                   type = TYPE_INDEX_TYPE (type);
3241                   /* Only re-evaluate the right hand side if the resulting type
3242                      is a variable length type.  */
3243                   if (TYPE_RANGE_DATA (type)->flag_bound_evaluated)
3244                     {
3245                       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3246                       return value_from_longest
3247                         (size_type, (LONGEST) TYPE_LENGTH (value_type (val)));
3248                     }
3249                 }
3250             }
3251         }
3252
3253       /* Fall through.  */
3254
3255     default:
3256       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3257       type = value_type (val);
3258       break;
3259     }
3260
3261   /* $5.3.3/2 of the C++ Standard (n3290 draft) says of sizeof:
3262      "When applied to a reference or a reference type, the result is
3263      the size of the referenced type."  */
3264   type = check_typedef (type);
3265   if (exp->language_defn->la_language == language_cplus
3266       && (TYPE_IS_REFERENCE (type)))
3267     type = check_typedef (TYPE_TARGET_TYPE (type));
3268   return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3269 }
3270
3271 /* Evaluate a subexpression of EXP, at index *POS, and return a value
3272    for that subexpression cast to TO_TYPE.  Advance *POS over the
3273    subexpression.  */
3274
3275 static value *
3276 evaluate_subexp_for_cast (expression *exp, int *pos,
3277                           enum noside noside,
3278                           struct type *to_type)
3279 {
3280   int pc = *pos;
3281
3282   /* Don't let symbols be evaluated with evaluate_subexp because that
3283      throws an "unknown type" error for no-debug data symbols.
3284      Instead, we want the cast to reinterpret the symbol.  */
3285   if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
3286       || exp->elts[pc].opcode == OP_VAR_VALUE)
3287     {
3288       (*pos) += 4;
3289
3290       value *val;
3291       if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
3292         {
3293           if (noside == EVAL_AVOID_SIDE_EFFECTS)
3294             return value_zero (to_type, not_lval);
3295
3296           val = evaluate_var_msym_value (noside,
3297                                          exp->elts[pc + 1].objfile,
3298                                          exp->elts[pc + 2].msymbol);
3299         }
3300       else
3301         val = evaluate_var_value (noside,
3302                                   exp->elts[pc + 1].block,
3303                                   exp->elts[pc + 2].symbol);
3304
3305       if (noside == EVAL_SKIP)
3306         return eval_skip_value (exp);
3307
3308       val = value_cast (to_type, val);
3309
3310       /* Don't allow e.g. '&(int)var_with_no_debug_info'.  */
3311       if (VALUE_LVAL (val) == lval_memory)
3312         {
3313           if (value_lazy (val))
3314             value_fetch_lazy (val);
3315           VALUE_LVAL (val) = not_lval;
3316         }
3317       return val;
3318     }
3319
3320   value *val = evaluate_subexp (to_type, exp, pos, noside);
3321   if (noside == EVAL_SKIP)
3322     return eval_skip_value (exp);
3323   return value_cast (to_type, val);
3324 }
3325
3326 /* Parse a type expression in the string [P..P+LENGTH).  */
3327
3328 struct type *
3329 parse_and_eval_type (char *p, int length)
3330 {
3331   char *tmp = (char *) alloca (length + 4);
3332
3333   tmp[0] = '(';
3334   memcpy (tmp + 1, p, length);
3335   tmp[length + 1] = ')';
3336   tmp[length + 2] = '0';
3337   tmp[length + 3] = '\0';
3338   expression_up expr = parse_expression (tmp);
3339   if (expr->elts[0].opcode != UNOP_CAST)
3340     error (_("Internal error in eval_type."));
3341   return expr->elts[1].type;
3342 }
3343
3344 int
3345 calc_f77_array_dims (struct type *array_type)
3346 {
3347   int ndimen = 1;
3348   struct type *tmp_type;
3349
3350   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3351     error (_("Can't get dimensions for a non-array type"));
3352
3353   tmp_type = array_type;
3354
3355   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3356     {
3357       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3358         ++ndimen;
3359     }
3360   return ndimen;
3361 }