gdb/eval.c

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