gdb/eval.c

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