gdb/eval.c

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