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
2497       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2498       if (noside == EVAL_SKIP)
2499         return eval_skip_value (exp);
2500       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2501         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2502       else
2503         {
2504           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2505           return value_complement (arg1);
2506         }
2507
2508     case UNOP_LOGICAL_NOT:
2509       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2510       if (noside == EVAL_SKIP)
2511         return eval_skip_value (exp);
2512       if (unop_user_defined_p (op, arg1))
2513         return value_x_unop (arg1, op, noside);
2514       else
2515         {
2516           type = language_bool_type (exp->language_defn, exp->gdbarch);
2517           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2518         }
2519
2520     case UNOP_IND:
2521       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2522         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2523       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2524       type = check_typedef (value_type (arg1));
2525       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2526           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2527         error (_("Attempt to dereference pointer "
2528                  "to member without an object"));
2529       if (noside == EVAL_SKIP)
2530         return eval_skip_value (exp);
2531       if (unop_user_defined_p (op, arg1))
2532         return value_x_unop (arg1, op, noside);
2533       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2534         {
2535           type = check_typedef (value_type (arg1));
2536           if (TYPE_CODE (type) == TYPE_CODE_PTR
2537               || TYPE_IS_REFERENCE (type)
2538           /* In C you can dereference an array to get the 1st elt.  */
2539               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2540             )
2541             return value_zero (TYPE_TARGET_TYPE (type),
2542                                lval_memory);
2543           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2544             /* GDB allows dereferencing an int.  */
2545             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2546                                lval_memory);
2547           else
2548             error (_("Attempt to take contents of a non-pointer value."));
2549         }
2550
2551       /* Allow * on an integer so we can cast it to whatever we want.
2552          This returns an int, which seems like the most C-like thing to
2553          do.  "long long" variables are rare enough that
2554          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2555       if (TYPE_CODE (type) == TYPE_CODE_INT)
2556         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2557                               (CORE_ADDR) value_as_address (arg1));
2558       return value_ind (arg1);
2559
2560     case UNOP_ADDR:
2561       /* C++: check for and handle pointer to members.  */
2562
2563       if (noside == EVAL_SKIP)
2564         {
2565           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2566           return eval_skip_value (exp);
2567         }
2568       else
2569         {
2570           struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2571                                                                noside);
2572
2573           return retvalp;
2574         }
2575
2576     case UNOP_SIZEOF:
2577       if (noside == EVAL_SKIP)
2578         {
2579           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2580           return eval_skip_value (exp);
2581         }
2582       return evaluate_subexp_for_sizeof (exp, pos, noside);
2583
2584     case UNOP_CAST:
2585       (*pos) += 2;
2586       type = exp->elts[pc + 1].type;
2587       arg1 = evaluate_subexp (type, exp, pos, noside);
2588       if (noside == EVAL_SKIP)
2589         return eval_skip_value (exp);
2590       if (type != value_type (arg1))
2591         arg1 = value_cast (type, arg1);
2592       return arg1;
2593
2594     case UNOP_CAST_TYPE:
2595       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2596       type = value_type (arg1);
2597       arg1 = evaluate_subexp (type, exp, pos, noside);
2598       if (noside == EVAL_SKIP)
2599         return eval_skip_value (exp);
2600       if (type != value_type (arg1))
2601         arg1 = value_cast (type, arg1);
2602       return arg1;
2603
2604     case UNOP_DYNAMIC_CAST:
2605       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2606       type = value_type (arg1);
2607       arg1 = evaluate_subexp (type, exp, pos, noside);
2608       if (noside == EVAL_SKIP)
2609         return eval_skip_value (exp);
2610       return value_dynamic_cast (type, arg1);
2611
2612     case UNOP_REINTERPRET_CAST:
2613       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2614       type = value_type (arg1);
2615       arg1 = evaluate_subexp (type, exp, pos, noside);
2616       if (noside == EVAL_SKIP)
2617         return eval_skip_value (exp);
2618       return value_reinterpret_cast (type, arg1);
2619
2620     case UNOP_MEMVAL:
2621       (*pos) += 2;
2622       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2623       if (noside == EVAL_SKIP)
2624         return eval_skip_value (exp);
2625       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2626         return value_zero (exp->elts[pc + 1].type, lval_memory);
2627       else
2628         return value_at_lazy (exp->elts[pc + 1].type,
2629                               value_as_address (arg1));
2630
2631     case UNOP_MEMVAL_TYPE:
2632       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2633       type = value_type (arg1);
2634       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2635       if (noside == EVAL_SKIP)
2636         return eval_skip_value (exp);
2637       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2638         return value_zero (type, lval_memory);
2639       else
2640         return value_at_lazy (type, value_as_address (arg1));
2641
2642     case UNOP_MEMVAL_TLS:
2643       (*pos) += 3;
2644       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2645       if (noside == EVAL_SKIP)
2646         return eval_skip_value (exp);
2647       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2648         return value_zero (exp->elts[pc + 2].type, lval_memory);
2649       else
2650         {
2651           CORE_ADDR tls_addr;
2652
2653           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2654                                                    value_as_address (arg1));
2655           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2656         }
2657
2658     case UNOP_PREINCREMENT:
2659       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2660       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2661         return arg1;
2662       else if (unop_user_defined_p (op, arg1))
2663         {
2664           return value_x_unop (arg1, op, noside);
2665         }
2666       else
2667         {
2668           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2669             arg2 = value_ptradd (arg1, 1);
2670           else
2671             {
2672               struct value *tmp = arg1;
2673
2674               arg2 = value_one (value_type (arg1));
2675               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2676               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2677             }
2678
2679           return value_assign (arg1, arg2);
2680         }
2681
2682     case UNOP_PREDECREMENT:
2683       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2684       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2685         return arg1;
2686       else if (unop_user_defined_p (op, arg1))
2687         {
2688           return value_x_unop (arg1, op, noside);
2689         }
2690       else
2691         {
2692           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2693             arg2 = value_ptradd (arg1, -1);
2694           else
2695             {
2696               struct value *tmp = arg1;
2697
2698               arg2 = value_one (value_type (arg1));
2699               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2700               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2701             }
2702
2703           return value_assign (arg1, arg2);
2704         }
2705
2706     case UNOP_POSTINCREMENT:
2707       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2708       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2709         return arg1;
2710       else if (unop_user_defined_p (op, arg1))
2711         {
2712           return value_x_unop (arg1, op, noside);
2713         }
2714       else
2715         {
2716           arg3 = value_non_lval (arg1);
2717
2718           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2719             arg2 = value_ptradd (arg1, 1);
2720           else
2721             {
2722               struct value *tmp = arg1;
2723
2724               arg2 = value_one (value_type (arg1));
2725               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2726               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2727             }
2728
2729           value_assign (arg1, arg2);
2730           return arg3;
2731         }
2732
2733     case UNOP_POSTDECREMENT:
2734       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2735       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2736         return arg1;
2737       else if (unop_user_defined_p (op, arg1))
2738         {
2739           return value_x_unop (arg1, op, noside);
2740         }
2741       else
2742         {
2743           arg3 = value_non_lval (arg1);
2744
2745           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2746             arg2 = value_ptradd (arg1, -1);
2747           else
2748             {
2749               struct value *tmp = arg1;
2750
2751               arg2 = value_one (value_type (arg1));
2752               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2753               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2754             }
2755
2756           value_assign (arg1, arg2);
2757           return arg3;
2758         }
2759
2760     case OP_THIS:
2761       (*pos) += 1;
2762       return value_of_this (exp->language_defn);
2763
2764     case OP_TYPE:
2765       /* The value is not supposed to be used.  This is here to make it
2766          easier to accommodate expressions that contain types.  */
2767       (*pos) += 2;
2768       if (noside == EVAL_SKIP)
2769         return eval_skip_value (exp);
2770       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2771         return allocate_value (exp->elts[pc + 1].type);
2772       else
2773         error (_("Attempt to use a type name as an expression"));
2774
2775     case OP_TYPEOF:
2776     case OP_DECLTYPE:
2777       if (noside == EVAL_SKIP)
2778         {
2779           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2780           return eval_skip_value (exp);
2781         }
2782       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2783         {
2784           enum exp_opcode sub_op = exp->elts[*pos].opcode;
2785           struct value *result;
2786
2787           result = evaluate_subexp (NULL_TYPE, exp, pos,
2788                                     EVAL_AVOID_SIDE_EFFECTS);
2789
2790           /* 'decltype' has special semantics for lvalues.  */
2791           if (op == OP_DECLTYPE
2792               && (sub_op == BINOP_SUBSCRIPT
2793                   || sub_op == STRUCTOP_MEMBER
2794                   || sub_op == STRUCTOP_MPTR
2795                   || sub_op == UNOP_IND
2796                   || sub_op == STRUCTOP_STRUCT
2797                   || sub_op == STRUCTOP_PTR
2798                   || sub_op == OP_SCOPE))
2799             {
2800               struct type *type = value_type (result);
2801
2802               if (!TYPE_IS_REFERENCE (type))
2803                 {
2804                   type = lookup_lvalue_reference_type (type);
2805                   result = allocate_value (type);
2806                 }
2807             }
2808
2809           return result;
2810         }
2811       else
2812         error (_("Attempt to use a type as an expression"));
2813
2814     case OP_TYPEID:
2815       {
2816         struct value *result;
2817         enum exp_opcode sub_op = exp->elts[*pos].opcode;
2818
2819         if (sub_op == OP_TYPE || sub_op == OP_DECLTYPE || sub_op == OP_TYPEOF)
2820           result = evaluate_subexp (NULL_TYPE, exp, pos,
2821                                     EVAL_AVOID_SIDE_EFFECTS);
2822         else
2823           result = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2824
2825         if (noside != EVAL_NORMAL)
2826           return allocate_value (cplus_typeid_type (exp->gdbarch));
2827
2828         return cplus_typeid (result);
2829       }
2830
2831     default:
2832       /* Removing this case and compiling with gcc -Wall reveals that
2833          a lot of cases are hitting this case.  Some of these should
2834          probably be removed from expression.h; others are legitimate
2835          expressions which are (apparently) not fully implemented.
2836
2837          If there are any cases landing here which mean a user error,
2838          then they should be separate cases, with more descriptive
2839          error messages.  */
2840
2841       error (_("GDB does not (yet) know how to "
2842                "evaluate that kind of expression"));
2843     }
2844
2845   gdb_assert_not_reached ("missed return?");
2846 }
2847 \f
2848 /* Evaluate a subexpression of EXP, at index *POS,
2849    and return the address of that subexpression.
2850    Advance *POS over the subexpression.
2851    If the subexpression isn't an lvalue, get an error.
2852    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2853    then only the type of the result need be correct.  */
2854
2855 static struct value *
2856 evaluate_subexp_for_address (struct expression *exp, int *pos,
2857                              enum noside noside)
2858 {
2859   enum exp_opcode op;
2860   int pc;
2861   struct symbol *var;
2862   struct value *x;
2863   int tem;
2864
2865   pc = (*pos);
2866   op = exp->elts[pc].opcode;
2867
2868   switch (op)
2869     {
2870     case UNOP_IND:
2871       (*pos)++;
2872       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2873
2874       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2875       if (unop_user_defined_p (op, x))
2876         {
2877           x = value_x_unop (x, op, noside);
2878           goto default_case_after_eval;
2879         }
2880
2881       return coerce_array (x);
2882
2883     case UNOP_MEMVAL:
2884       (*pos) += 3;
2885       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2886                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2887
2888     case UNOP_MEMVAL_TYPE:
2889       {
2890         struct type *type;
2891
2892         (*pos) += 1;
2893         x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2894         type = value_type (x);
2895         return value_cast (lookup_pointer_type (type),
2896                            evaluate_subexp (NULL_TYPE, exp, pos, noside));
2897       }
2898
2899     case OP_VAR_VALUE:
2900       var = exp->elts[pc + 2].symbol;
2901
2902       /* C++: The "address" of a reference should yield the address
2903        * of the object pointed to.  Let value_addr() deal with it.  */
2904       if (TYPE_IS_REFERENCE (SYMBOL_TYPE (var)))
2905         goto default_case;
2906
2907       (*pos) += 4;
2908       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2909         {
2910           struct type *type =
2911             lookup_pointer_type (SYMBOL_TYPE (var));
2912           enum address_class sym_class = SYMBOL_CLASS (var);
2913
2914           if (sym_class == LOC_CONST
2915               || sym_class == LOC_CONST_BYTES
2916               || sym_class == LOC_REGISTER)
2917             error (_("Attempt to take address of register or constant."));
2918
2919           return
2920             value_zero (type, not_lval);
2921         }
2922       else
2923         return address_of_variable (var, exp->elts[pc + 1].block);
2924
2925     case OP_SCOPE:
2926       tem = longest_to_int (exp->elts[pc + 2].longconst);
2927       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2928       x = value_aggregate_elt (exp->elts[pc + 1].type,
2929                                &exp->elts[pc + 3].string,
2930                                NULL, 1, noside);
2931       if (x == NULL)
2932         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2933       return x;
2934
2935     default:
2936     default_case:
2937       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2938     default_case_after_eval:
2939       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2940         {
2941           struct type *type = check_typedef (value_type (x));
2942
2943           if (TYPE_IS_REFERENCE (type))
2944             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2945                                not_lval);
2946           else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2947             return value_zero (lookup_pointer_type (value_type (x)),
2948                                not_lval);
2949           else
2950             error (_("Attempt to take address of "
2951                      "value not located in memory."));
2952         }
2953       return value_addr (x);
2954     }
2955 }
2956
2957 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2958    When used in contexts where arrays will be coerced anyway, this is
2959    equivalent to `evaluate_subexp' but much faster because it avoids
2960    actually fetching array contents (perhaps obsolete now that we have
2961    value_lazy()).
2962
2963    Note that we currently only do the coercion for C expressions, where
2964    arrays are zero based and the coercion is correct.  For other languages,
2965    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2966    to decide if coercion is appropriate.  */
2967
2968 struct value *
2969 evaluate_subexp_with_coercion (struct expression *exp,
2970                                int *pos, enum noside noside)
2971 {
2972   enum exp_opcode op;
2973   int pc;
2974   struct value *val;
2975   struct symbol *var;
2976   struct type *type;
2977
2978   pc = (*pos);
2979   op = exp->elts[pc].opcode;
2980
2981   switch (op)
2982     {
2983     case OP_VAR_VALUE:
2984       var = exp->elts[pc + 2].symbol;
2985       type = check_typedef (SYMBOL_TYPE (var));
2986       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
2987           && !TYPE_VECTOR (type)
2988           && CAST_IS_CONVERSION (exp->language_defn))
2989         {
2990           (*pos) += 4;
2991           val = address_of_variable (var, exp->elts[pc + 1].block);
2992           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2993                              val);
2994         }
2995       /* FALLTHROUGH */
2996
2997     default:
2998       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2999     }
3000 }
3001
3002 /* Evaluate a subexpression of EXP, at index *POS,
3003    and return a value for the size of that subexpression.
3004    Advance *POS over the subexpression.  If NOSIDE is EVAL_NORMAL
3005    we allow side-effects on the operand if its type is a variable
3006    length array.   */
3007
3008 static struct value *
3009 evaluate_subexp_for_sizeof (struct expression *exp, int *pos,
3010                             enum noside noside)
3011 {
3012   /* FIXME: This should be size_t.  */
3013   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3014   enum exp_opcode op;
3015   int pc;
3016   struct type *type;
3017   struct value *val;
3018
3019   pc = (*pos);
3020   op = exp->elts[pc].opcode;
3021
3022   switch (op)
3023     {
3024       /* This case is handled specially
3025          so that we avoid creating a value for the result type.
3026          If the result type is very big, it's desirable not to
3027          create a value unnecessarily.  */
3028     case UNOP_IND:
3029       (*pos)++;
3030       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3031       type = check_typedef (value_type (val));
3032       if (TYPE_CODE (type) != TYPE_CODE_PTR
3033           && !TYPE_IS_REFERENCE (type)
3034           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3035         error (_("Attempt to take contents of a non-pointer value."));
3036       type = TYPE_TARGET_TYPE (type);
3037       if (is_dynamic_type (type))
3038         type = value_type (value_ind (val));
3039       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3040
3041     case UNOP_MEMVAL:
3042       (*pos) += 3;
3043       type = exp->elts[pc + 1].type;
3044       break;
3045
3046     case UNOP_MEMVAL_TYPE:
3047       (*pos) += 1;
3048       val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3049       type = value_type (val);
3050       break;
3051
3052     case OP_VAR_VALUE:
3053       type = SYMBOL_TYPE (exp->elts[pc + 2].symbol);
3054       if (is_dynamic_type (type))
3055         {
3056           val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3057           type = value_type (val);
3058         }
3059       else
3060         (*pos) += 4;
3061       break;
3062
3063       /* Deal with the special case if NOSIDE is EVAL_NORMAL and the resulting
3064          type of the subscript is a variable length array type. In this case we
3065          must re-evaluate the right hand side of the subcription to allow
3066          side-effects. */
3067     case BINOP_SUBSCRIPT:
3068       if (noside == EVAL_NORMAL)
3069         {
3070           int pc = (*pos) + 1;
3071
3072           val = evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
3073           type = check_typedef (value_type (val));
3074           if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3075             {
3076               type = check_typedef (TYPE_TARGET_TYPE (type));
3077               if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3078                 {
3079                   type = TYPE_INDEX_TYPE (type);
3080                   /* Only re-evaluate the right hand side if the resulting type
3081                      is a variable length type.  */
3082                   if (TYPE_RANGE_DATA (type)->flag_bound_evaluated)
3083                     {
3084                       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3085                       return value_from_longest
3086                         (size_type, (LONGEST) TYPE_LENGTH (value_type (val)));
3087                     }
3088                 }
3089             }
3090         }
3091
3092       /* Fall through.  */
3093
3094     default:
3095       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3096       type = value_type (val);
3097       break;
3098     }
3099
3100   /* $5.3.3/2 of the C++ Standard (n3290 draft) says of sizeof:
3101      "When applied to a reference or a reference type, the result is
3102      the size of the referenced type."  */
3103   type = check_typedef (type);
3104   if (exp->language_defn->la_language == language_cplus
3105       && (TYPE_IS_REFERENCE (type)))
3106     type = check_typedef (TYPE_TARGET_TYPE (type));
3107   return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3108 }
3109
3110 /* Parse a type expression in the string [P..P+LENGTH).  */
3111
3112 struct type *
3113 parse_and_eval_type (char *p, int length)
3114 {
3115   char *tmp = (char *) alloca (length + 4);
3116
3117   tmp[0] = '(';
3118   memcpy (tmp + 1, p, length);
3119   tmp[length + 1] = ')';
3120   tmp[length + 2] = '0';
3121   tmp[length + 3] = '\0';
3122   expression_up expr = parse_expression (tmp);
3123   if (expr->elts[0].opcode != UNOP_CAST)
3124     error (_("Internal error in eval_type."));
3125   return expr->elts[1].type;
3126 }
3127
3128 int
3129 calc_f77_array_dims (struct type *array_type)
3130 {
3131   int ndimen = 1;
3132   struct type *tmp_type;
3133
3134   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3135     error (_("Can't get dimensions for a non-array type"));
3136
3137   tmp_type = array_type;
3138
3139   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3140     {
3141       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3142         ++ndimen;
3143     }
3144   return ndimen;
3145 }