gdb/eval.c

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