gdb/eval.c

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