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_COMPUTED_OPS (sym) == NULL
 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       /* Also handle EVAL_AVOID_SIDE_EFFECTS.  */
1851       return value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
1852                                NULL, "structure");
1853
1854     case STRUCTOP_PTR:
1855       tem = longest_to_int (exp->elts[pc + 1].longconst);
1856       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1857       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1858       if (noside == EVAL_SKIP)
1859         goto nosideret;
1860
1861       /* Check to see if operator '->' has been overloaded.  If so replace
1862          arg1 with the value returned by evaluating operator->().  */
1863       while (unop_user_defined_p (op, arg1))
1864         {
1865           volatile struct gdb_exception except;
1866           struct value *value = NULL;
1867           TRY_CATCH (except, RETURN_MASK_ERROR)
1868             {
1869               value = value_x_unop (arg1, op, noside);
1870             }
1871
1872           if (except.reason < 0)
1873             {
1874               if (except.error == NOT_FOUND_ERROR)
1875                 break;
1876               else
1877                 throw_exception (except);
1878             }
1879           arg1 = value;
1880         }
1881
1882       /* JYG: if print object is on we need to replace the base type
1883          with rtti type in order to continue on with successful
1884          lookup of member / method only available in the rtti type.  */
1885       {
1886         struct type *type = value_type (arg1);
1887         struct type *real_type;
1888         int full, top, using_enc;
1889         struct value_print_options opts;
1890
1891         get_user_print_options (&opts);
1892         if (opts.objectprint && TYPE_TARGET_TYPE(type)
1893             && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1894           {
1895             real_type = value_rtti_indirect_type (arg1, &full, &top,
1896                                                   &using_enc);
1897             if (real_type)
1898                 arg1 = value_cast (real_type, arg1);
1899           }
1900       }
1901
1902       /* Also handle EVAL_AVOID_SIDE_EFFECTS.  */
1903       return value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
1904                                NULL, "structure pointer");
1905
1906     case STRUCTOP_MEMBER:
1907     case STRUCTOP_MPTR:
1908       if (op == STRUCTOP_MEMBER)
1909         arg1 = evaluate_subexp_for_address (exp, pos, noside);
1910       else
1911         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1912
1913       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1914
1915       if (noside == EVAL_SKIP)
1916         goto nosideret;
1917
1918       type = check_typedef (value_type (arg2));
1919       switch (TYPE_CODE (type))
1920         {
1921         case TYPE_CODE_METHODPTR:
1922           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1923             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
1924           else
1925             {
1926               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
1927               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
1928               return value_ind (arg2);
1929             }
1930
1931         case TYPE_CODE_MEMBERPTR:
1932           /* Now, convert these values to an address.  */
1933           arg1 = value_cast_pointers (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1934                                       arg1, 1);
1935
1936           mem_offset = value_as_long (arg2);
1937
1938           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1939                                      value_as_long (arg1) + mem_offset);
1940           return value_ind (arg3);
1941
1942         default:
1943           error (_("non-pointer-to-member value used "
1944                    "in pointer-to-member construct"));
1945         }
1946
1947     case TYPE_INSTANCE:
1948       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1949       arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
1950       for (ix = 0; ix < nargs; ++ix)
1951         arg_types[ix] = exp->elts[pc + 1 + ix + 1].type;
1952
1953       expect_type = make_params (nargs, arg_types);
1954       *(pos) += 3 + nargs;
1955       arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
1956       xfree (TYPE_FIELDS (expect_type));
1957       xfree (TYPE_MAIN_TYPE (expect_type));
1958       xfree (expect_type);
1959       return arg1;
1960
1961     case BINOP_CONCAT:
1962       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1963       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1964       if (noside == EVAL_SKIP)
1965         goto nosideret;
1966       if (binop_user_defined_p (op, arg1, arg2))
1967         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1968       else
1969         return value_concat (arg1, arg2);
1970
1971     case BINOP_ASSIGN:
1972       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1973       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1974
1975       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1976         return arg1;
1977       if (binop_user_defined_p (op, arg1, arg2))
1978         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1979       else
1980         return value_assign (arg1, arg2);
1981
1982     case BINOP_ASSIGN_MODIFY:
1983       (*pos) += 2;
1984       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1985       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1986       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1987         return arg1;
1988       op = exp->elts[pc + 1].opcode;
1989       if (binop_user_defined_p (op, arg1, arg2))
1990         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1991       else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
1992                                                   value_type (arg1))
1993                && is_integral_type (value_type (arg2)))
1994         arg2 = value_ptradd (arg1, value_as_long (arg2));
1995       else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
1996                                                   value_type (arg1))
1997                && is_integral_type (value_type (arg2)))
1998         arg2 = value_ptradd (arg1, - value_as_long (arg2));
1999       else
2000         {
2001           struct value *tmp = arg1;
2002
2003           /* For shift and integer exponentiation operations,
2004              only promote the first argument.  */
2005           if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2006               && is_integral_type (value_type (arg2)))
2007             unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2008           else
2009             binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2010
2011           arg2 = value_binop (tmp, arg2, op);
2012         }
2013       return value_assign (arg1, arg2);
2014
2015     case BINOP_ADD:
2016       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2017       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2018       if (noside == EVAL_SKIP)
2019         goto nosideret;
2020       if (binop_user_defined_p (op, arg1, arg2))
2021         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2022       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2023                && is_integral_type (value_type (arg2)))
2024         return value_ptradd (arg1, value_as_long (arg2));
2025       else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2026                && is_integral_type (value_type (arg1)))
2027         return value_ptradd (arg2, value_as_long (arg1));
2028       else
2029         {
2030           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2031           return value_binop (arg1, arg2, BINOP_ADD);
2032         }
2033
2034     case BINOP_SUB:
2035       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2036       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2037       if (noside == EVAL_SKIP)
2038         goto nosideret;
2039       if (binop_user_defined_p (op, arg1, arg2))
2040         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2041       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2042                && ptrmath_type_p (exp->language_defn, value_type (arg2)))
2043         {
2044           /* FIXME -- should be ptrdiff_t */
2045           type = builtin_type (exp->gdbarch)->builtin_long;
2046           return value_from_longest (type, value_ptrdiff (arg1, arg2));
2047         }
2048       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2049                && is_integral_type (value_type (arg2)))
2050         return value_ptradd (arg1, - value_as_long (arg2));
2051       else
2052         {
2053           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2054           return value_binop (arg1, arg2, BINOP_SUB);
2055         }
2056
2057     case BINOP_EXP:
2058     case BINOP_MUL:
2059     case BINOP_DIV:
2060     case BINOP_INTDIV:
2061     case BINOP_REM:
2062     case BINOP_MOD:
2063     case BINOP_LSH:
2064     case BINOP_RSH:
2065     case BINOP_BITWISE_AND:
2066     case BINOP_BITWISE_IOR:
2067     case BINOP_BITWISE_XOR:
2068       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2069       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2070       if (noside == EVAL_SKIP)
2071         goto nosideret;
2072       if (binop_user_defined_p (op, arg1, arg2))
2073         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2074       else
2075         {
2076           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2077              fudge arg2 to avoid division-by-zero, the caller is
2078              (theoretically) only looking for the type of the result.  */
2079           if (noside == EVAL_AVOID_SIDE_EFFECTS
2080               /* ??? Do we really want to test for BINOP_MOD here?
2081                  The implementation of value_binop gives it a well-defined
2082                  value.  */
2083               && (op == BINOP_DIV
2084                   || op == BINOP_INTDIV
2085                   || op == BINOP_REM
2086                   || op == BINOP_MOD)
2087               && value_logical_not (arg2))
2088             {
2089               struct value *v_one, *retval;
2090
2091               v_one = value_one (value_type (arg2));
2092               binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
2093               retval = value_binop (arg1, v_one, op);
2094               return retval;
2095             }
2096           else
2097             {
2098               /* For shift and integer exponentiation operations,
2099                  only promote the first argument.  */
2100               if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2101                   && is_integral_type (value_type (arg2)))
2102                 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2103               else
2104                 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2105
2106               return value_binop (arg1, arg2, op);
2107             }
2108         }
2109
2110     case BINOP_RANGE:
2111       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2112       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2113       if (noside == EVAL_SKIP)
2114         goto nosideret;
2115       error (_("':' operator used in invalid context"));
2116
2117     case BINOP_SUBSCRIPT:
2118       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2119       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2120       if (noside == EVAL_SKIP)
2121         goto nosideret;
2122       if (binop_user_defined_p (op, arg1, arg2))
2123         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2124       else
2125         {
2126           /* If the user attempts to subscript something that is not an
2127              array or pointer type (like a plain int variable for example),
2128              then report this as an error.  */
2129
2130           arg1 = coerce_ref (arg1);
2131           type = check_typedef (value_type (arg1));
2132           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
2133               && TYPE_CODE (type) != TYPE_CODE_PTR)
2134             {
2135               if (TYPE_NAME (type))
2136                 error (_("cannot subscript something of type `%s'"),
2137                        TYPE_NAME (type));
2138               else
2139                 error (_("cannot subscript requested type"));
2140             }
2141
2142           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2143             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2144           else
2145             return value_subscript (arg1, value_as_long (arg2));
2146         }
2147
2148     case BINOP_IN:
2149       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2150       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2151       if (noside == EVAL_SKIP)
2152         goto nosideret;
2153       type = language_bool_type (exp->language_defn, exp->gdbarch);
2154       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
2155
2156     case MULTI_SUBSCRIPT:
2157       (*pos) += 2;
2158       nargs = longest_to_int (exp->elts[pc + 1].longconst);
2159       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2160       while (nargs-- > 0)
2161         {
2162           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2163           /* FIXME:  EVAL_SKIP handling may not be correct.  */
2164           if (noside == EVAL_SKIP)
2165             {
2166               if (nargs > 0)
2167                 {
2168                   continue;
2169                 }
2170               else
2171                 {
2172                   goto nosideret;
2173                 }
2174             }
2175           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct.  */
2176           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2177             {
2178               /* If the user attempts to subscript something that has no target
2179                  type (like a plain int variable for example), then report this
2180                  as an error.  */
2181
2182               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
2183               if (type != NULL)
2184                 {
2185                   arg1 = value_zero (type, VALUE_LVAL (arg1));
2186                   noside = EVAL_SKIP;
2187                   continue;
2188                 }
2189               else
2190                 {
2191                   error (_("cannot subscript something of type `%s'"),
2192                          TYPE_NAME (value_type (arg1)));
2193                 }
2194             }
2195
2196           if (binop_user_defined_p (op, arg1, arg2))
2197             {
2198               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2199             }
2200           else
2201             {
2202               arg1 = coerce_ref (arg1);
2203               type = check_typedef (value_type (arg1));
2204
2205               switch (TYPE_CODE (type))
2206                 {
2207                 case TYPE_CODE_PTR:
2208                 case TYPE_CODE_ARRAY:
2209                 case TYPE_CODE_STRING:
2210                   arg1 = value_subscript (arg1, value_as_long (arg2));
2211                   break;
2212
2213                 default:
2214                   if (TYPE_NAME (type))
2215                     error (_("cannot subscript something of type `%s'"),
2216                            TYPE_NAME (type));
2217                   else
2218                     error (_("cannot subscript requested type"));
2219                 }
2220             }
2221         }
2222       return (arg1);
2223
2224     multi_f77_subscript:
2225       {
2226         LONGEST subscript_array[MAX_FORTRAN_DIMS];
2227         int ndimensions = 1, i;
2228         struct value *array = arg1;
2229
2230         if (nargs > MAX_FORTRAN_DIMS)
2231           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2232
2233         ndimensions = calc_f77_array_dims (type);
2234
2235         if (nargs != ndimensions)
2236           error (_("Wrong number of subscripts"));
2237
2238         gdb_assert (nargs > 0);
2239
2240         /* Now that we know we have a legal array subscript expression
2241            let us actually find out where this element exists in the array.  */
2242
2243         /* Take array indices left to right.  */
2244         for (i = 0; i < nargs; i++)
2245           {
2246             /* Evaluate each subscript; it must be a legal integer in F77.  */
2247             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2248
2249             /* Fill in the subscript array.  */
2250
2251             subscript_array[i] = value_as_long (arg2);
2252           }
2253
2254         /* Internal type of array is arranged right to left.  */
2255         for (i = nargs; i > 0; i--)
2256           {
2257             struct type *array_type = check_typedef (value_type (array));
2258             LONGEST index = subscript_array[i - 1];
2259
2260             array = value_subscripted_rvalue (array, index,
2261                                               f77_get_lowerbound (array_type));
2262           }
2263
2264         return array;
2265       }
2266
2267     case BINOP_LOGICAL_AND:
2268       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2269       if (noside == EVAL_SKIP)
2270         {
2271           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2272           goto nosideret;
2273         }
2274
2275       oldpos = *pos;
2276       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2277       *pos = oldpos;
2278
2279       if (binop_user_defined_p (op, arg1, arg2))
2280         {
2281           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2282           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2283         }
2284       else
2285         {
2286           tem = value_logical_not (arg1);
2287           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2288                                   (tem ? EVAL_SKIP : noside));
2289           type = language_bool_type (exp->language_defn, exp->gdbarch);
2290           return value_from_longest (type,
2291                              (LONGEST) (!tem && !value_logical_not (arg2)));
2292         }
2293
2294     case BINOP_LOGICAL_OR:
2295       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2296       if (noside == EVAL_SKIP)
2297         {
2298           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2299           goto nosideret;
2300         }
2301
2302       oldpos = *pos;
2303       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2304       *pos = oldpos;
2305
2306       if (binop_user_defined_p (op, arg1, arg2))
2307         {
2308           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2309           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2310         }
2311       else
2312         {
2313           tem = value_logical_not (arg1);
2314           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2315                                   (!tem ? EVAL_SKIP : noside));
2316           type = language_bool_type (exp->language_defn, exp->gdbarch);
2317           return value_from_longest (type,
2318                              (LONGEST) (!tem || !value_logical_not (arg2)));
2319         }
2320
2321     case BINOP_EQUAL:
2322       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2323       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2324       if (noside == EVAL_SKIP)
2325         goto nosideret;
2326       if (binop_user_defined_p (op, arg1, arg2))
2327         {
2328           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2329         }
2330       else
2331         {
2332           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2333           tem = value_equal (arg1, arg2);
2334           type = language_bool_type (exp->language_defn, exp->gdbarch);
2335           return value_from_longest (type, (LONGEST) tem);
2336         }
2337
2338     case BINOP_NOTEQUAL:
2339       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2340       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2341       if (noside == EVAL_SKIP)
2342         goto nosideret;
2343       if (binop_user_defined_p (op, arg1, arg2))
2344         {
2345           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2346         }
2347       else
2348         {
2349           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2350           tem = value_equal (arg1, arg2);
2351           type = language_bool_type (exp->language_defn, exp->gdbarch);
2352           return value_from_longest (type, (LONGEST) ! tem);
2353         }
2354
2355     case BINOP_LESS:
2356       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2357       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2358       if (noside == EVAL_SKIP)
2359         goto nosideret;
2360       if (binop_user_defined_p (op, arg1, arg2))
2361         {
2362           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2363         }
2364       else
2365         {
2366           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2367           tem = value_less (arg1, arg2);
2368           type = language_bool_type (exp->language_defn, exp->gdbarch);
2369           return value_from_longest (type, (LONGEST) tem);
2370         }
2371
2372     case BINOP_GTR:
2373       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2374       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2375       if (noside == EVAL_SKIP)
2376         goto nosideret;
2377       if (binop_user_defined_p (op, arg1, arg2))
2378         {
2379           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2380         }
2381       else
2382         {
2383           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2384           tem = value_less (arg2, arg1);
2385           type = language_bool_type (exp->language_defn, exp->gdbarch);
2386           return value_from_longest (type, (LONGEST) tem);
2387         }
2388
2389     case BINOP_GEQ:
2390       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2391       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2392       if (noside == EVAL_SKIP)
2393         goto nosideret;
2394       if (binop_user_defined_p (op, arg1, arg2))
2395         {
2396           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2397         }
2398       else
2399         {
2400           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2401           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2402           type = language_bool_type (exp->language_defn, exp->gdbarch);
2403           return value_from_longest (type, (LONGEST) tem);
2404         }
2405
2406     case BINOP_LEQ:
2407       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2408       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2409       if (noside == EVAL_SKIP)
2410         goto nosideret;
2411       if (binop_user_defined_p (op, arg1, arg2))
2412         {
2413           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2414         }
2415       else
2416         {
2417           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2418           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2419           type = language_bool_type (exp->language_defn, exp->gdbarch);
2420           return value_from_longest (type, (LONGEST) tem);
2421         }
2422
2423     case BINOP_REPEAT:
2424       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2425       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2426       if (noside == EVAL_SKIP)
2427         goto nosideret;
2428       type = check_typedef (value_type (arg2));
2429       if (TYPE_CODE (type) != TYPE_CODE_INT)
2430         error (_("Non-integral right operand for \"@\" operator."));
2431       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2432         {
2433           return allocate_repeat_value (value_type (arg1),
2434                                      longest_to_int (value_as_long (arg2)));
2435         }
2436       else
2437         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2438
2439     case BINOP_COMMA:
2440       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2441       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2442
2443     case UNOP_PLUS:
2444       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2445       if (noside == EVAL_SKIP)
2446         goto nosideret;
2447       if (unop_user_defined_p (op, arg1))
2448         return value_x_unop (arg1, op, noside);
2449       else
2450         {
2451           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2452           return value_pos (arg1);
2453         }
2454
2455     case UNOP_NEG:
2456       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2457       if (noside == EVAL_SKIP)
2458         goto nosideret;
2459       if (unop_user_defined_p (op, arg1))
2460         return value_x_unop (arg1, op, noside);
2461       else
2462         {
2463           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2464           return value_neg (arg1);
2465         }
2466
2467     case UNOP_COMPLEMENT:
2468       /* C++: check for and handle destructor names.  */
2469       op = exp->elts[*pos].opcode;
2470
2471       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2472       if (noside == EVAL_SKIP)
2473         goto nosideret;
2474       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2475         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2476       else
2477         {
2478           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2479           return value_complement (arg1);
2480         }
2481
2482     case UNOP_LOGICAL_NOT:
2483       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2484       if (noside == EVAL_SKIP)
2485         goto nosideret;
2486       if (unop_user_defined_p (op, arg1))
2487         return value_x_unop (arg1, op, noside);
2488       else
2489         {
2490           type = language_bool_type (exp->language_defn, exp->gdbarch);
2491           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2492         }
2493
2494     case UNOP_IND:
2495       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2496         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2497       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2498       type = check_typedef (value_type (arg1));
2499       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2500           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2501         error (_("Attempt to dereference pointer "
2502                  "to member without an object"));
2503       if (noside == EVAL_SKIP)
2504         goto nosideret;
2505       if (unop_user_defined_p (op, arg1))
2506         return value_x_unop (arg1, op, noside);
2507       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2508         {
2509           type = check_typedef (value_type (arg1));
2510           if (TYPE_CODE (type) == TYPE_CODE_PTR
2511               || TYPE_CODE (type) == TYPE_CODE_REF
2512           /* In C you can dereference an array to get the 1st elt.  */
2513               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2514             )
2515             return value_zero (TYPE_TARGET_TYPE (type),
2516                                lval_memory);
2517           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2518             /* GDB allows dereferencing an int.  */
2519             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2520                                lval_memory);
2521           else
2522             error (_("Attempt to take contents of a non-pointer value."));
2523         }
2524
2525       /* Allow * on an integer so we can cast it to whatever we want.
2526          This returns an int, which seems like the most C-like thing to
2527          do.  "long long" variables are rare enough that
2528          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2529       if (TYPE_CODE (type) == TYPE_CODE_INT)
2530         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2531                               (CORE_ADDR) value_as_address (arg1));
2532       return value_ind (arg1);
2533
2534     case UNOP_ADDR:
2535       /* C++: check for and handle pointer to members.  */
2536
2537       op = exp->elts[*pos].opcode;
2538
2539       if (noside == EVAL_SKIP)
2540         {
2541           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2542           goto nosideret;
2543         }
2544       else
2545         {
2546           struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2547                                                                noside);
2548
2549           return retvalp;
2550         }
2551
2552     case UNOP_SIZEOF:
2553       if (noside == EVAL_SKIP)
2554         {
2555           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2556           goto nosideret;
2557         }
2558       return evaluate_subexp_for_sizeof (exp, pos);
2559
2560     case UNOP_CAST:
2561       (*pos) += 2;
2562       type = exp->elts[pc + 1].type;
2563       arg1 = evaluate_subexp (type, exp, pos, noside);
2564       if (noside == EVAL_SKIP)
2565         goto nosideret;
2566       if (type != value_type (arg1))
2567         arg1 = value_cast (type, arg1);
2568       return arg1;
2569
2570     case UNOP_CAST_TYPE:
2571       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2572       type = value_type (arg1);
2573       arg1 = evaluate_subexp (type, exp, pos, noside);
2574       if (noside == EVAL_SKIP)
2575         goto nosideret;
2576       if (type != value_type (arg1))
2577         arg1 = value_cast (type, arg1);
2578       return arg1;
2579
2580     case UNOP_DYNAMIC_CAST:
2581       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2582       type = value_type (arg1);
2583       arg1 = evaluate_subexp (type, exp, pos, noside);
2584       if (noside == EVAL_SKIP)
2585         goto nosideret;
2586       return value_dynamic_cast (type, arg1);
2587
2588     case UNOP_REINTERPRET_CAST:
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       return value_reinterpret_cast (type, arg1);
2595
2596     case UNOP_MEMVAL:
2597       (*pos) += 2;
2598       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2599       if (noside == EVAL_SKIP)
2600         goto nosideret;
2601       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2602         return value_zero (exp->elts[pc + 1].type, lval_memory);
2603       else
2604         return value_at_lazy (exp->elts[pc + 1].type,
2605                               value_as_address (arg1));
2606
2607     case UNOP_MEMVAL_TYPE:
2608       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2609       type = value_type (arg1);
2610       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2611       if (noside == EVAL_SKIP)
2612         goto nosideret;
2613       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2614         return value_zero (type, lval_memory);
2615       else
2616         return value_at_lazy (type, value_as_address (arg1));
2617
2618     case UNOP_MEMVAL_TLS:
2619       (*pos) += 3;
2620       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2621       if (noside == EVAL_SKIP)
2622         goto nosideret;
2623       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2624         return value_zero (exp->elts[pc + 2].type, lval_memory);
2625       else
2626         {
2627           CORE_ADDR tls_addr;
2628
2629           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2630                                                    value_as_address (arg1));
2631           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2632         }
2633
2634     case UNOP_PREINCREMENT:
2635       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2636       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2637         return arg1;
2638       else if (unop_user_defined_p (op, arg1))
2639         {
2640           return value_x_unop (arg1, op, noside);
2641         }
2642       else
2643         {
2644           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2645             arg2 = value_ptradd (arg1, 1);
2646           else
2647             {
2648               struct value *tmp = arg1;
2649
2650               arg2 = value_one (value_type (arg1));
2651               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2652               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2653             }
2654
2655           return value_assign (arg1, arg2);
2656         }
2657
2658     case UNOP_PREDECREMENT:
2659       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2660       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2661         return arg1;
2662       else if (unop_user_defined_p (op, arg1))
2663         {
2664           return value_x_unop (arg1, op, noside);
2665         }
2666       else
2667         {
2668           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2669             arg2 = value_ptradd (arg1, -1);
2670           else
2671             {
2672               struct value *tmp = arg1;
2673
2674               arg2 = value_one (value_type (arg1));
2675               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2676               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2677             }
2678
2679           return value_assign (arg1, arg2);
2680         }
2681
2682     case UNOP_POSTINCREMENT:
2683       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2684       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2685         return arg1;
2686       else if (unop_user_defined_p (op, arg1))
2687         {
2688           return value_x_unop (arg1, op, noside);
2689         }
2690       else
2691         {
2692           arg3 = value_non_lval (arg1);
2693
2694           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2695             arg2 = value_ptradd (arg1, 1);
2696           else
2697             {
2698               struct value *tmp = arg1;
2699
2700               arg2 = value_one (value_type (arg1));
2701               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2702               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2703             }
2704
2705           value_assign (arg1, arg2);
2706           return arg3;
2707         }
2708
2709     case UNOP_POSTDECREMENT:
2710       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2711       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2712         return arg1;
2713       else if (unop_user_defined_p (op, arg1))
2714         {
2715           return value_x_unop (arg1, op, noside);
2716         }
2717       else
2718         {
2719           arg3 = value_non_lval (arg1);
2720
2721           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2722             arg2 = value_ptradd (arg1, -1);
2723           else
2724             {
2725               struct value *tmp = arg1;
2726
2727               arg2 = value_one (value_type (arg1));
2728               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2729               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2730             }
2731
2732           value_assign (arg1, arg2);
2733           return arg3;
2734         }
2735
2736     case OP_THIS:
2737       (*pos) += 1;
2738       return value_of_this (exp->language_defn);
2739
2740     case OP_TYPE:
2741       /* The value is not supposed to be used.  This is here to make it
2742          easier to accommodate expressions that contain types.  */
2743       (*pos) += 2;
2744       if (noside == EVAL_SKIP)
2745         goto nosideret;
2746       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2747         {
2748           struct type *type = exp->elts[pc + 1].type;
2749
2750           /* If this is a typedef, then find its immediate target.  We
2751              use check_typedef to resolve stubs, but we ignore its
2752              result because we do not want to dig past all
2753              typedefs.  */
2754           check_typedef (type);
2755           if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
2756             type = TYPE_TARGET_TYPE (type);
2757           return allocate_value (type);
2758         }
2759       else
2760         error (_("Attempt to use a type name as an expression"));
2761
2762     case OP_TYPEOF:
2763     case OP_DECLTYPE:
2764       if (noside == EVAL_SKIP)
2765         {
2766           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2767           goto nosideret;
2768         }
2769       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2770         {
2771           enum exp_opcode sub_op = exp->elts[*pos].opcode;
2772           struct value *result;
2773
2774           result = evaluate_subexp (NULL_TYPE, exp, pos,
2775                                     EVAL_AVOID_SIDE_EFFECTS);
2776
2777           /* 'decltype' has special semantics for lvalues.  */
2778           if (op == OP_DECLTYPE
2779               && (sub_op == BINOP_SUBSCRIPT
2780                   || sub_op == STRUCTOP_MEMBER
2781                   || sub_op == STRUCTOP_MPTR
2782                   || sub_op == UNOP_IND
2783                   || sub_op == STRUCTOP_STRUCT
2784                   || sub_op == STRUCTOP_PTR
2785                   || sub_op == OP_SCOPE))
2786             {
2787               struct type *type = value_type (result);
2788
2789               if (TYPE_CODE (check_typedef (type)) != TYPE_CODE_REF)
2790                 {
2791                   type = lookup_reference_type (type);
2792                   result = allocate_value (type);
2793                 }
2794             }
2795
2796           return result;
2797         }
2798       else
2799         error (_("Attempt to use a type as an expression"));
2800
2801     case OP_TYPEID:
2802       {
2803         struct value *result;
2804         enum exp_opcode sub_op = exp->elts[*pos].opcode;
2805
2806         if (sub_op == OP_TYPE || sub_op == OP_DECLTYPE || sub_op == OP_TYPEOF)
2807           result = evaluate_subexp (NULL_TYPE, exp, pos,
2808                                     EVAL_AVOID_SIDE_EFFECTS);
2809         else
2810           result = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2811
2812         if (noside != EVAL_NORMAL)
2813           return allocate_value (cplus_typeid_type (exp->gdbarch));
2814
2815         return cplus_typeid (result);
2816       }
2817
2818     default:
2819       /* Removing this case and compiling with gcc -Wall reveals that
2820          a lot of cases are hitting this case.  Some of these should
2821          probably be removed from expression.h; others are legitimate
2822          expressions which are (apparently) not fully implemented.
2823
2824          If there are any cases landing here which mean a user error,
2825          then they should be separate cases, with more descriptive
2826          error messages.  */
2827
2828       error (_("GDB does not (yet) know how to "
2829                "evaluate that kind of expression"));
2830     }
2831
2832 nosideret:
2833   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
2834 }
2835 \f
2836 /* Evaluate a subexpression of EXP, at index *POS,
2837    and return the address of that subexpression.
2838    Advance *POS over the subexpression.
2839    If the subexpression isn't an lvalue, get an error.
2840    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2841    then only the type of the result need be correct.  */
2842
2843 static struct value *
2844 evaluate_subexp_for_address (struct expression *exp, int *pos,
2845                              enum noside noside)
2846 {
2847   enum exp_opcode op;
2848   int pc;
2849   struct symbol *var;
2850   struct value *x;
2851   int tem;
2852
2853   pc = (*pos);
2854   op = exp->elts[pc].opcode;
2855
2856   switch (op)
2857     {
2858     case UNOP_IND:
2859       (*pos)++;
2860       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2861
2862       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2863       if (unop_user_defined_p (op, x))
2864         {
2865           x = value_x_unop (x, op, noside);
2866           goto default_case_after_eval;
2867         }
2868
2869       return coerce_array (x);
2870
2871     case UNOP_MEMVAL:
2872       (*pos) += 3;
2873       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2874                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2875
2876     case UNOP_MEMVAL_TYPE:
2877       {
2878         struct type *type;
2879
2880         (*pos) += 1;
2881         x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2882         type = value_type (x);
2883         return value_cast (lookup_pointer_type (type),
2884                            evaluate_subexp (NULL_TYPE, exp, pos, noside));
2885       }
2886
2887     case OP_VAR_VALUE:
2888       var = exp->elts[pc + 2].symbol;
2889
2890       /* C++: The "address" of a reference should yield the address
2891        * of the object pointed to.  Let value_addr() deal with it.  */
2892       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2893         goto default_case;
2894
2895       (*pos) += 4;
2896       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2897         {
2898           struct type *type =
2899             lookup_pointer_type (SYMBOL_TYPE (var));
2900           enum address_class sym_class = SYMBOL_CLASS (var);
2901
2902           if (sym_class == LOC_CONST
2903               || sym_class == LOC_CONST_BYTES
2904               || sym_class == LOC_REGISTER)
2905             error (_("Attempt to take address of register or constant."));
2906
2907           return
2908             value_zero (type, not_lval);
2909         }
2910       else
2911         return address_of_variable (var, exp->elts[pc + 1].block);
2912
2913     case OP_SCOPE:
2914       tem = longest_to_int (exp->elts[pc + 2].longconst);
2915       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2916       x = value_aggregate_elt (exp->elts[pc + 1].type,
2917                                &exp->elts[pc + 3].string,
2918                                NULL, 1, noside);
2919       if (x == NULL)
2920         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2921       return x;
2922
2923     default:
2924     default_case:
2925       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2926     default_case_after_eval:
2927       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2928         {
2929           struct type *type = check_typedef (value_type (x));
2930
2931           if (TYPE_CODE (type) == TYPE_CODE_REF)
2932             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2933                                not_lval);
2934           else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2935             return value_zero (lookup_pointer_type (value_type (x)),
2936                                not_lval);
2937           else
2938             error (_("Attempt to take address of "
2939                      "value not located in memory."));
2940         }
2941       return value_addr (x);
2942     }
2943 }
2944
2945 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2946    When used in contexts where arrays will be coerced anyway, this is
2947    equivalent to `evaluate_subexp' but much faster because it avoids
2948    actually fetching array contents (perhaps obsolete now that we have
2949    value_lazy()).
2950
2951    Note that we currently only do the coercion for C expressions, where
2952    arrays are zero based and the coercion is correct.  For other languages,
2953    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2954    to decide if coercion is appropriate.  */
2955
2956 struct value *
2957 evaluate_subexp_with_coercion (struct expression *exp,
2958                                int *pos, enum noside noside)
2959 {
2960   enum exp_opcode op;
2961   int pc;
2962   struct value *val;
2963   struct symbol *var;
2964   struct type *type;
2965
2966   pc = (*pos);
2967   op = exp->elts[pc].opcode;
2968
2969   switch (op)
2970     {
2971     case OP_VAR_VALUE:
2972       var = exp->elts[pc + 2].symbol;
2973       type = check_typedef (SYMBOL_TYPE (var));
2974       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
2975           && !TYPE_VECTOR (type)
2976           && CAST_IS_CONVERSION (exp->language_defn))
2977         {
2978           (*pos) += 4;
2979           val = address_of_variable (var, exp->elts[pc + 1].block);
2980           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2981                              val);
2982         }
2983       /* FALLTHROUGH */
2984
2985     default:
2986       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2987     }
2988 }
2989
2990 /* Evaluate a subexpression of EXP, at index *POS,
2991    and return a value for the size of that subexpression.
2992    Advance *POS over the subexpression.  */
2993
2994 static struct value *
2995 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2996 {
2997   /* FIXME: This should be size_t.  */
2998   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
2999   enum exp_opcode op;
3000   int pc;
3001   struct type *type;
3002   struct value *val;
3003
3004   pc = (*pos);
3005   op = exp->elts[pc].opcode;
3006
3007   switch (op)
3008     {
3009       /* This case is handled specially
3010          so that we avoid creating a value for the result type.
3011          If the result type is very big, it's desirable not to
3012          create a value unnecessarily.  */
3013     case UNOP_IND:
3014       (*pos)++;
3015       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3016       type = check_typedef (value_type (val));
3017       if (TYPE_CODE (type) != TYPE_CODE_PTR
3018           && TYPE_CODE (type) != TYPE_CODE_REF
3019           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3020         error (_("Attempt to take contents of a non-pointer value."));
3021       type = check_typedef (TYPE_TARGET_TYPE (type));
3022       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3023
3024     case UNOP_MEMVAL:
3025       (*pos) += 3;
3026       type = check_typedef (exp->elts[pc + 1].type);
3027       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3028
3029     case UNOP_MEMVAL_TYPE:
3030       (*pos) += 1;
3031       val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3032       type = check_typedef (value_type (val));
3033       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3034
3035     case OP_VAR_VALUE:
3036       (*pos) += 4;
3037       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
3038       return
3039         value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3040
3041     default:
3042       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3043       return value_from_longest (size_type,
3044                                  (LONGEST) TYPE_LENGTH (value_type (val)));
3045     }
3046 }
3047
3048 /* Parse a type expression in the string [P..P+LENGTH).  */
3049
3050 struct type *
3051 parse_and_eval_type (char *p, int length)
3052 {
3053   char *tmp = (char *) alloca (length + 4);
3054   struct expression *expr;
3055
3056   tmp[0] = '(';
3057   memcpy (tmp + 1, p, length);
3058   tmp[length + 1] = ')';
3059   tmp[length + 2] = '0';
3060   tmp[length + 3] = '\0';
3061   expr = parse_expression (tmp);
3062   if (expr->elts[0].opcode != UNOP_CAST)
3063     error (_("Internal error in eval_type."));
3064   return expr->elts[1].type;
3065 }
3066
3067 int
3068 calc_f77_array_dims (struct type *array_type)
3069 {
3070   int ndimen = 1;
3071   struct type *tmp_type;
3072
3073   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3074     error (_("Can't get dimensions for a non-array type"));
3075
3076   tmp_type = array_type;
3077
3078   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3079     {
3080       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3081         ++ndimen;
3082     }
3083   return ndimen;
3084 }