gdb/eval.c

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