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 lower;
 814   int code;
 815   int ix;
 816   long mem_offset;
 817   struct type **arg_types;
 818   int save_pos1;
 819   struct symbol *function = NULL;
 820   char *function_name = NULL;
 821
 822   pc = (*pos)++;
 823   op = exp->elts[pc].opcode;
 824
 825   switch (op)
 826     {
 827     case OP_SCOPE:
 828       tem = longest_to_int (exp->elts[pc + 2].longconst);
 829       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
 830       if (noside == EVAL_SKIP)
 831         goto nosideret;
 832       arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
 833                                   &exp->elts[pc + 3].string,
 834                                   expect_type, 0, noside);
 835       if (arg1 == NULL)
 836         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
 837       return arg1;
 838
 839     case OP_LONG:
 840       (*pos) += 3;
 841       return value_from_longest (exp->elts[pc + 1].type,
 842                                  exp->elts[pc + 2].longconst);
 843
 844     case OP_DOUBLE:
 845       (*pos) += 3;
 846       return value_from_double (exp->elts[pc + 1].type,
 847                                 exp->elts[pc + 2].doubleconst);
 848
 849     case OP_DECFLOAT:
 850       (*pos) += 3;
 851       return value_from_decfloat (exp->elts[pc + 1].type,
 852                                   exp->elts[pc + 2].decfloatconst);
 853
 854     case OP_ADL_FUNC:
 855     case OP_VAR_VALUE:
 856       (*pos) += 3;
 857       if (noside == EVAL_SKIP)
 858         goto nosideret;
 859
 860       /* JYG: We used to just return value_zero of the symbol type
 861          if we're asked to avoid side effects.  Otherwise we return
 862          value_of_variable (...).  However I'm not sure if
 863          value_of_variable () has any side effect.
 864          We need a full value object returned here for whatis_exp ()
 865          to call evaluate_type () and then pass the full value to
 866          value_rtti_target_type () if we are dealing with a pointer
 867          or reference to a base class and print object is on.  */
 868
 869       {
 870         volatile struct gdb_exception except;
 871         struct value *ret = NULL;
 872
 873         TRY_CATCH (except, RETURN_MASK_ERROR)
 874           {
 875             ret = value_of_variable (exp->elts[pc + 2].symbol,
 876                                      exp->elts[pc + 1].block);
 877           }
 878
 879         if (except.reason < 0)
 880           {
 881             if (noside == EVAL_AVOID_SIDE_EFFECTS)
 882               ret = value_zero (SYMBOL_TYPE (exp->elts[pc + 2].symbol),
 883                                 not_lval);
 884             else
 885               throw_exception (except);
 886           }
 887
 888         return ret;
 889       }
 890
 891     case OP_VAR_ENTRY_VALUE:
 892       (*pos) += 2;
 893       if (noside == EVAL_SKIP)
 894         goto nosideret;
 895
 896       {
 897         struct symbol *sym = exp->elts[pc + 1].symbol;
 898         struct frame_info *frame;
 899
 900         if (noside == EVAL_AVOID_SIDE_EFFECTS)
 901           return value_zero (SYMBOL_TYPE (sym), not_lval);
 902
 903         if (SYMBOL_CLASS (sym) != LOC_COMPUTED
 904             || SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry == NULL)
 905           error (_("Symbol \"%s\" does not have any specific entry value"),
 906                  SYMBOL_PRINT_NAME (sym));
 907
 908         frame = get_selected_frame (NULL);
 909         return SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry (sym, frame);
 910       }
 911
 912     case OP_LAST:
 913       (*pos) += 2;
 914       return
 915         access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
 916
 917     case OP_REGISTER:
 918       {
 919         const char *name = &exp->elts[pc + 2].string;
 920         int regno;
 921         struct value *val;
 922
 923         (*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
 924         regno = user_reg_map_name_to_regnum (exp->gdbarch,
 925                                              name, strlen (name));
 926         if (regno == -1)
 927           error (_("Register $%s not available."), name);
 928
 929         /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
 930            a value with the appropriate register type.  Unfortunately,
 931            we don't have easy access to the type of user registers.
 932            So for these registers, we fetch the register value regardless
 933            of the evaluation mode.  */
 934         if (noside == EVAL_AVOID_SIDE_EFFECTS
 935             && regno < gdbarch_num_regs (exp->gdbarch)
 936                         + gdbarch_num_pseudo_regs (exp->gdbarch))
 937           val = value_zero (register_type (exp->gdbarch, regno), not_lval);
 938         else
 939           val = value_of_register (regno, get_selected_frame (NULL));
 940         if (val == NULL)
 941           error (_("Value of register %s not available."), name);
 942         else
 943           return val;
 944       }
 945     case OP_BOOL:
 946       (*pos) += 2;
 947       type = language_bool_type (exp->language_defn, exp->gdbarch);
 948       return value_from_longest (type, exp->elts[pc + 1].longconst);
 949
 950     case OP_INTERNALVAR:
 951       (*pos) += 2;
 952       return value_of_internalvar (exp->gdbarch,
 953                                    exp->elts[pc + 1].internalvar);
 954
 955     case OP_STRING:
 956       tem = longest_to_int (exp->elts[pc + 1].longconst);
 957       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 958       if (noside == EVAL_SKIP)
 959         goto nosideret;
 960       type = language_string_char_type (exp->language_defn, exp->gdbarch);
 961       return value_string (&exp->elts[pc + 2].string, tem, type);
 962
 963     case OP_OBJC_NSSTRING:              /* Objective C Foundation Class
 964                                            NSString constant.  */
 965       tem = longest_to_int (exp->elts[pc + 1].longconst);
 966       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 967       if (noside == EVAL_SKIP)
 968         {
 969           goto nosideret;
 970         }
 971       return value_nsstring (exp->gdbarch, &exp->elts[pc + 2].string, tem + 1);
 972
 973     case OP_ARRAY:
 974       (*pos) += 3;
 975       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 976       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 977       nargs = tem3 - tem2 + 1;
 978       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 979
 980       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 981           && TYPE_CODE (type) == TYPE_CODE_STRUCT)
 982         {
 983           struct value *rec = allocate_value (expect_type);
 984
 985           memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
 986           return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
 987         }
 988
 989       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 990           && TYPE_CODE (type) == TYPE_CODE_ARRAY)
 991         {
 992           struct type *range_type = TYPE_INDEX_TYPE (type);
 993           struct type *element_type = TYPE_TARGET_TYPE (type);
 994           struct value *array = allocate_value (expect_type);
 995           int element_size = TYPE_LENGTH (check_typedef (element_type));
 996           LONGEST low_bound, high_bound, index;
 997
 998           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 999             {
1000               low_bound = 0;
1001               high_bound = (TYPE_LENGTH (type) / element_size) - 1;
1002             }
1003           index = low_bound;
1004           memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
1005           for (tem = nargs; --nargs >= 0;)
1006             {
1007               struct value *element;
1008               int index_pc = 0;
1009
1010               if (exp->elts[*pos].opcode == BINOP_RANGE)
1011                 {
1012                   index_pc = ++(*pos);
1013                   evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1014                 }
1015               element = evaluate_subexp (element_type, exp, pos, noside);
1016               if (value_type (element) != element_type)
1017                 element = value_cast (element_type, element);
1018               if (index_pc)
1019                 {
1020                   int continue_pc = *pos;
1021
1022                   *pos = index_pc;
1023                   index = init_array_element (array, element, exp, pos, noside,
1024                                               low_bound, high_bound);
1025                   *pos = continue_pc;
1026                 }
1027               else
1028                 {
1029                   if (index > high_bound)
1030                     /* To avoid memory corruption.  */
1031                     error (_("Too many array elements"));
1032                   memcpy (value_contents_raw (array)
1033                           + (index - low_bound) * element_size,
1034                           value_contents (element),
1035                           element_size);
1036                 }
1037               index++;
1038             }
1039           return array;
1040         }
1041
1042       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1043           && TYPE_CODE (type) == TYPE_CODE_SET)
1044         {
1045           struct value *set = allocate_value (expect_type);
1046           gdb_byte *valaddr = value_contents_raw (set);
1047           struct type *element_type = TYPE_INDEX_TYPE (type);
1048           struct type *check_type = element_type;
1049           LONGEST low_bound, high_bound;
1050
1051           /* Get targettype of elementtype.  */
1052           while (TYPE_CODE (check_type) == TYPE_CODE_RANGE
1053                  || TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
1054             check_type = TYPE_TARGET_TYPE (check_type);
1055
1056           if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
1057             error (_("(power)set type with unknown size"));
1058           memset (valaddr, '\0', TYPE_LENGTH (type));
1059           for (tem = 0; tem < nargs; tem++)
1060             {
1061               LONGEST range_low, range_high;
1062               struct type *range_low_type, *range_high_type;
1063               struct value *elem_val;
1064
1065               if (exp->elts[*pos].opcode == BINOP_RANGE)
1066                 {
1067                   (*pos)++;
1068                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
1069                   range_low_type = value_type (elem_val);
1070                   range_low = value_as_long (elem_val);
1071                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
1072                   range_high_type = value_type (elem_val);
1073                   range_high = value_as_long (elem_val);
1074                 }
1075               else
1076                 {
1077                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
1078                   range_low_type = range_high_type = value_type (elem_val);
1079                   range_low = range_high = value_as_long (elem_val);
1080                 }
1081               /* Check types of elements to avoid mixture of elements from
1082                  different types. Also check if type of element is "compatible"
1083                  with element type of powerset.  */
1084               if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
1085                 range_low_type = TYPE_TARGET_TYPE (range_low_type);
1086               if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
1087                 range_high_type = TYPE_TARGET_TYPE (range_high_type);
1088               if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type))
1089                   || (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM
1090                       && (range_low_type != range_high_type)))
1091                 /* different element modes.  */
1092                 error (_("POWERSET tuple elements of different mode"));
1093               if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type))
1094                   || (TYPE_CODE (check_type) == TYPE_CODE_ENUM
1095                       && range_low_type != check_type))
1096                 error (_("incompatible POWERSET tuple elements"));
1097               if (range_low > range_high)
1098                 {
1099                   warning (_("empty POWERSET tuple range"));
1100                   continue;
1101                 }
1102               if (range_low < low_bound || range_high > high_bound)
1103                 error (_("POWERSET tuple element out of range"));
1104               range_low -= low_bound;
1105               range_high -= low_bound;
1106               for (; range_low <= range_high; range_low++)
1107                 {
1108                   int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
1109
1110                   if (gdbarch_bits_big_endian (exp->gdbarch))
1111                     bit_index = TARGET_CHAR_BIT - 1 - bit_index;
1112                   valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
1113                     |= 1 << bit_index;
1114                 }
1115             }
1116           return set;
1117         }
1118
1119       argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
1120       for (tem = 0; tem < nargs; tem++)
1121         {
1122           /* Ensure that array expressions are coerced into pointer
1123              objects.  */
1124           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1125         }
1126       if (noside == EVAL_SKIP)
1127         goto nosideret;
1128       return value_array (tem2, tem3, argvec);
1129
1130     case TERNOP_SLICE:
1131       {
1132         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1133         int lowbound
1134           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1135         int upper
1136           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1137
1138         if (noside == EVAL_SKIP)
1139           goto nosideret;
1140         return value_slice (array, lowbound, upper - lowbound + 1);
1141       }
1142
1143     case TERNOP_COND:
1144       /* Skip third and second args to evaluate the first one.  */
1145       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1146       if (value_logical_not (arg1))
1147         {
1148           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1149           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1150         }
1151       else
1152         {
1153           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1154           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1155           return arg2;
1156         }
1157
1158     case OP_OBJC_SELECTOR:
1159       {                         /* Objective C @selector operator.  */
1160         char *sel = &exp->elts[pc + 2].string;
1161         int len = longest_to_int (exp->elts[pc + 1].longconst);
1162         struct type *selector_type;
1163
1164         (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1165         if (noside == EVAL_SKIP)
1166           goto nosideret;
1167
1168         if (sel[len] != 0)
1169           sel[len] = 0;         /* Make sure it's terminated.  */
1170
1171         selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1172         return value_from_longest (selector_type,
1173                                    lookup_child_selector (exp->gdbarch, sel));
1174       }
1175
1176     case OP_OBJC_MSGCALL:
1177       {                         /* Objective C message (method) call.  */
1178
1179         CORE_ADDR responds_selector = 0;
1180         CORE_ADDR method_selector = 0;
1181
1182         CORE_ADDR selector = 0;
1183
1184         int struct_return = 0;
1185         int sub_no_side = 0;
1186
1187         struct value *msg_send = NULL;
1188         struct value *msg_send_stret = NULL;
1189         int gnu_runtime = 0;
1190
1191         struct value *target = NULL;
1192         struct value *method = NULL;
1193         struct value *called_method = NULL;
1194
1195         struct type *selector_type = NULL;
1196         struct type *long_type;
1197
1198         struct value *ret = NULL;
1199         CORE_ADDR addr = 0;
1200
1201         selector = exp->elts[pc + 1].longconst;
1202         nargs = exp->elts[pc + 2].longconst;
1203         argvec = (struct value **) alloca (sizeof (struct value *)
1204                                            * (nargs + 5));
1205
1206         (*pos) += 3;
1207
1208         long_type = builtin_type (exp->gdbarch)->builtin_long;
1209         selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1210
1211         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1212           sub_no_side = EVAL_NORMAL;
1213         else
1214           sub_no_side = noside;
1215
1216         target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1217
1218         if (value_as_long (target) == 0)
1219           return value_from_longest (long_type, 0);
1220
1221         if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0))
1222           gnu_runtime = 1;
1223
1224         /* Find the method dispatch (Apple runtime) or method lookup
1225            (GNU runtime) function for Objective-C.  These will be used
1226            to lookup the symbol information for the method.  If we
1227            can't find any symbol information, then we'll use these to
1228            call the method, otherwise we can call the method
1229            directly.  The msg_send_stret function is used in the special
1230            case of a method that returns a structure (Apple runtime
1231            only).  */
1232         if (gnu_runtime)
1233           {
1234             struct type *type = selector_type;
1235
1236             type = lookup_function_type (type);
1237             type = lookup_pointer_type (type);
1238             type = lookup_function_type (type);
1239             type = lookup_pointer_type (type);
1240
1241             msg_send = find_function_in_inferior ("objc_msg_lookup", NULL);
1242             msg_send_stret
1243               = find_function_in_inferior ("objc_msg_lookup", NULL);
1244
1245             msg_send = value_from_pointer (type, value_as_address (msg_send));
1246             msg_send_stret = value_from_pointer (type,
1247                                         value_as_address (msg_send_stret));
1248           }
1249         else
1250           {
1251             msg_send = find_function_in_inferior ("objc_msgSend", NULL);
1252             /* Special dispatcher for methods returning structs.  */
1253             msg_send_stret
1254               = find_function_in_inferior ("objc_msgSend_stret", NULL);
1255           }
1256
1257         /* Verify the target object responds to this method.  The
1258            standard top-level 'Object' class uses a different name for
1259            the verification method than the non-standard, but more
1260            often used, 'NSObject' class.  Make sure we check for both.  */
1261
1262         responds_selector
1263           = lookup_child_selector (exp->gdbarch, "respondsToSelector:");
1264         if (responds_selector == 0)
1265           responds_selector
1266             = lookup_child_selector (exp->gdbarch, "respondsTo:");
1267
1268         if (responds_selector == 0)
1269           error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1270
1271         method_selector
1272           = lookup_child_selector (exp->gdbarch, "methodForSelector:");
1273         if (method_selector == 0)
1274           method_selector
1275             = lookup_child_selector (exp->gdbarch, "methodFor:");
1276
1277         if (method_selector == 0)
1278           error (_("no 'methodFor:' or 'methodForSelector:' method"));
1279
1280         /* Call the verification method, to make sure that the target
1281          class implements the desired method.  */
1282
1283         argvec[0] = msg_send;
1284         argvec[1] = target;
1285         argvec[2] = value_from_longest (long_type, responds_selector);
1286         argvec[3] = value_from_longest (long_type, selector);
1287         argvec[4] = 0;
1288
1289         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1290         if (gnu_runtime)
1291           {
1292             /* Function objc_msg_lookup returns a pointer.  */
1293             argvec[0] = ret;
1294             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1295           }
1296         if (value_as_long (ret) == 0)
1297           error (_("Target does not respond to this message selector."));
1298
1299         /* Call "methodForSelector:" method, to get the address of a
1300            function method that implements this selector for this
1301            class.  If we can find a symbol at that address, then we
1302            know the return type, parameter types etc.  (that's a good
1303            thing).  */
1304
1305         argvec[0] = msg_send;
1306         argvec[1] = target;
1307         argvec[2] = value_from_longest (long_type, method_selector);
1308         argvec[3] = value_from_longest (long_type, selector);
1309         argvec[4] = 0;
1310
1311         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1312         if (gnu_runtime)
1313           {
1314             argvec[0] = ret;
1315             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1316           }
1317
1318         /* ret should now be the selector.  */
1319
1320         addr = value_as_long (ret);
1321         if (addr)
1322           {
1323             struct symbol *sym = NULL;
1324
1325             /* The address might point to a function descriptor;
1326                resolve it to the actual code address instead.  */
1327             addr = gdbarch_convert_from_func_ptr_addr (exp->gdbarch, addr,
1328                                                        &current_target);
1329
1330             /* Is it a high_level symbol?  */
1331             sym = find_pc_function (addr);
1332             if (sym != NULL)
1333               method = value_of_variable (sym, 0);
1334           }
1335
1336         /* If we found a method with symbol information, check to see
1337            if it returns a struct.  Otherwise assume it doesn't.  */
1338
1339         if (method)
1340           {
1341             CORE_ADDR funaddr;
1342             struct type *val_type;
1343
1344             funaddr = find_function_addr (method, &val_type);
1345
1346             block_for_pc (funaddr);
1347
1348             CHECK_TYPEDEF (val_type);
1349
1350             if ((val_type == NULL)
1351                 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1352               {
1353                 if (expect_type != NULL)
1354                   val_type = expect_type;
1355               }
1356
1357             struct_return = using_struct_return (exp->gdbarch, method,
1358                                                  val_type);
1359           }
1360         else if (expect_type != NULL)
1361           {
1362             struct_return = using_struct_return (exp->gdbarch, NULL,
1363                                                  check_typedef (expect_type));
1364           }
1365
1366         /* Found a function symbol.  Now we will substitute its
1367            value in place of the message dispatcher (obj_msgSend),
1368            so that we call the method directly instead of thru
1369            the dispatcher.  The main reason for doing this is that
1370            we can now evaluate the return value and parameter values
1371            according to their known data types, in case we need to
1372            do things like promotion, dereferencing, special handling
1373            of structs and doubles, etc.
1374
1375            We want to use the type signature of 'method', but still
1376            jump to objc_msgSend() or objc_msgSend_stret() to better
1377            mimic the behavior of the runtime.  */
1378
1379         if (method)
1380           {
1381             if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1382               error (_("method address has symbol information "
1383                        "with non-function type; skipping"));
1384
1385             /* Create a function pointer of the appropriate type, and
1386                replace its value with the value of msg_send or
1387                msg_send_stret.  We must use a pointer here, as
1388                msg_send and msg_send_stret are of pointer type, and
1389                the representation may be different on systems that use
1390                function descriptors.  */
1391             if (struct_return)
1392               called_method
1393                 = value_from_pointer (lookup_pointer_type (value_type (method)),
1394                                       value_as_address (msg_send_stret));
1395             else
1396               called_method
1397                 = value_from_pointer (lookup_pointer_type (value_type (method)),
1398                                       value_as_address (msg_send));
1399           }
1400         else
1401           {
1402             if (struct_return)
1403               called_method = msg_send_stret;
1404             else
1405               called_method = msg_send;
1406           }
1407
1408         if (noside == EVAL_SKIP)
1409           goto nosideret;
1410
1411         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1412           {
1413             /* If the return type doesn't look like a function type,
1414                call an error.  This can happen if somebody tries to
1415                turn a variable into a function call.  This is here
1416                because people often want to call, eg, strcmp, which
1417                gdb doesn't know is a function.  If gdb isn't asked for
1418                it's opinion (ie. through "whatis"), it won't offer
1419                it.  */
1420
1421             struct type *type = value_type (called_method);
1422
1423             if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1424               type = TYPE_TARGET_TYPE (type);
1425             type = TYPE_TARGET_TYPE (type);
1426
1427             if (type)
1428             {
1429               if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1430                 return allocate_value (expect_type);
1431               else
1432                 return allocate_value (type);
1433             }
1434             else
1435               error (_("Expression of type other than "
1436                        "\"method returning ...\" used as a method"));
1437           }
1438
1439         /* Now depending on whether we found a symbol for the method,
1440            we will either call the runtime dispatcher or the method
1441            directly.  */
1442
1443         argvec[0] = called_method;
1444         argvec[1] = target;
1445         argvec[2] = value_from_longest (long_type, selector);
1446         /* User-supplied arguments.  */
1447         for (tem = 0; tem < nargs; tem++)
1448           argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1449         argvec[tem + 3] = 0;
1450
1451         if (gnu_runtime && (method != NULL))
1452           {
1453             /* Function objc_msg_lookup returns a pointer.  */
1454             deprecated_set_value_type (argvec[0],
1455                                        lookup_pointer_type (lookup_function_type (value_type (argvec[0]))));
1456             argvec[0]
1457               = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1458           }
1459
1460         ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1461         return ret;
1462       }
1463       break;
1464
1465     case OP_FUNCALL:
1466       (*pos) += 2;
1467       op = exp->elts[*pos].opcode;
1468       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1469       /* Allocate arg vector, including space for the function to be
1470          called in argvec[0] and a terminating NULL.  */
1471       argvec = (struct value **)
1472         alloca (sizeof (struct value *) * (nargs + 3));
1473       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1474         {
1475           nargs++;
1476           /* First, evaluate the structure into arg2.  */
1477           pc2 = (*pos)++;
1478
1479           if (noside == EVAL_SKIP)
1480             goto nosideret;
1481
1482           if (op == STRUCTOP_MEMBER)
1483             {
1484               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1485             }
1486           else
1487             {
1488               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1489             }
1490
1491           /* If the function is a virtual function, then the
1492              aggregate value (providing the structure) plays
1493              its part by providing the vtable.  Otherwise,
1494              it is just along for the ride: call the function
1495              directly.  */
1496
1497           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1498
1499           if (TYPE_CODE (check_typedef (value_type (arg1)))
1500               != TYPE_CODE_METHODPTR)
1501             error (_("Non-pointer-to-member value used in pointer-to-member "
1502                      "construct"));
1503
1504           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1505             {
1506               struct type *method_type = check_typedef (value_type (arg1));
1507
1508               arg1 = value_zero (method_type, not_lval);
1509             }
1510           else
1511             arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1512
1513           /* Now, say which argument to start evaluating from.  */
1514           tem = 2;
1515         }
1516       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1517         {
1518           /* Hair for method invocations.  */
1519           int tem2;
1520
1521           nargs++;
1522           /* First, evaluate the structure into arg2.  */
1523           pc2 = (*pos)++;
1524           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1525           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1526           if (noside == EVAL_SKIP)
1527             goto nosideret;
1528
1529           if (op == STRUCTOP_STRUCT)
1530             {
1531               /* If v is a variable in a register, and the user types
1532                  v.method (), this will produce an error, because v has
1533                  no address.
1534
1535                  A possible way around this would be to allocate a
1536                  copy of the variable on the stack, copy in the
1537                  contents, call the function, and copy out the
1538                  contents.  I.e. convert this from call by reference
1539                  to call by copy-return (or whatever it's called).
1540                  However, this does not work because it is not the
1541                  same: the method being called could stash a copy of
1542                  the address, and then future uses through that address
1543                  (after the method returns) would be expected to
1544                  use the variable itself, not some copy of it.  */
1545               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1546             }
1547           else
1548             {
1549               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1550
1551               /* Check to see if the operator '->' has been
1552                  overloaded.  If the operator has been overloaded
1553                  replace arg2 with the value returned by the custom
1554                  operator and continue evaluation.  */
1555               while (unop_user_defined_p (op, arg2))
1556                 {
1557                   volatile struct gdb_exception except;
1558                   struct value *value = NULL;
1559                   TRY_CATCH (except, RETURN_MASK_ERROR)
1560                     {
1561                       value = value_x_unop (arg2, op, noside);
1562                     }
1563
1564                   if (except.reason < 0)
1565                     {
1566                       if (except.error == NOT_FOUND_ERROR)
1567                         break;
1568                       else
1569                         throw_exception (except);
1570                     }
1571                   arg2 = value;
1572                 }
1573             }
1574           /* Now, say which argument to start evaluating from.  */
1575           tem = 2;
1576         }
1577       else if (op == OP_SCOPE
1578                && overload_resolution
1579                && (exp->language_defn->la_language == language_cplus))
1580         {
1581           /* Unpack it locally so we can properly handle overload
1582              resolution.  */
1583           char *name;
1584           int local_tem;
1585
1586           pc2 = (*pos)++;
1587           local_tem = longest_to_int (exp->elts[pc2 + 2].longconst);
1588           (*pos) += 4 + BYTES_TO_EXP_ELEM (local_tem + 1);
1589           type = exp->elts[pc2 + 1].type;
1590           name = &exp->elts[pc2 + 3].string;
1591
1592           function = NULL;
1593           function_name = NULL;
1594           if (TYPE_CODE (type) == TYPE_CODE_NAMESPACE)
1595             {
1596               function = cp_lookup_symbol_namespace (TYPE_TAG_NAME (type),
1597                                                      name,
1598                                                      get_selected_block (0),
1599                                                      VAR_DOMAIN);
1600               if (function == NULL)
1601                 error (_("No symbol \"%s\" in namespace \"%s\"."),
1602                        name, TYPE_TAG_NAME (type));
1603
1604               tem = 1;
1605             }
1606           else
1607             {
1608               gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT
1609                           || TYPE_CODE (type) == TYPE_CODE_UNION);
1610               function_name = name;
1611
1612               arg2 = value_zero (type, lval_memory);
1613               ++nargs;
1614               tem = 2;
1615             }
1616         }
1617       else if (op == OP_ADL_FUNC)
1618         {
1619           /* Save the function position and move pos so that the arguments
1620              can be evaluated.  */
1621           int func_name_len;
1622
1623           save_pos1 = *pos;
1624           tem = 1;
1625
1626           func_name_len = longest_to_int (exp->elts[save_pos1 + 3].longconst);
1627           (*pos) += 6 + BYTES_TO_EXP_ELEM (func_name_len + 1);
1628         }
1629       else
1630         {
1631           /* Non-method function call.  */
1632           save_pos1 = *pos;
1633           tem = 1;
1634
1635           /* If this is a C++ function wait until overload resolution.  */
1636           if (op == OP_VAR_VALUE
1637               && overload_resolution
1638               && (exp->language_defn->la_language == language_cplus))
1639             {
1640               (*pos) += 4; /* Skip the evaluation of the symbol.  */
1641               argvec[0] = NULL;
1642             }
1643           else
1644             {
1645               argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1646               type = value_type (argvec[0]);
1647               if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1648                 type = TYPE_TARGET_TYPE (type);
1649               if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1650                 {
1651                   for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1652                     {
1653                       argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type,
1654                                                                       tem - 1),
1655                                                      exp, pos, noside);
1656                     }
1657                 }
1658             }
1659         }
1660
1661       /* Evaluate arguments.  */
1662       for (; tem <= nargs; tem++)
1663         {
1664           /* Ensure that array expressions are coerced into pointer
1665              objects.  */
1666           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1667         }
1668
1669       /* Signal end of arglist.  */
1670       argvec[tem] = 0;
1671       if (op == OP_ADL_FUNC)
1672         {
1673           struct symbol *symp;
1674           char *func_name;
1675           int  name_len;
1676           int string_pc = save_pos1 + 3;
1677
1678           /* Extract the function name.  */
1679           name_len = longest_to_int (exp->elts[string_pc].longconst);
1680           func_name = (char *) alloca (name_len + 1);
1681           strcpy (func_name, &exp->elts[string_pc + 1].string);
1682
1683           find_overload_match (&argvec[1], nargs, func_name,
1684                                NON_METHOD, /* not method */
1685                                0,          /* strict match */
1686                                NULL, NULL, /* pass NULL symbol since
1687                                               symbol is unknown */
1688                                NULL, &symp, NULL, 0);
1689
1690           /* Now fix the expression being evaluated.  */
1691           exp->elts[save_pos1 + 2].symbol = symp;
1692           argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1693         }
1694
1695       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR
1696           || (op == OP_SCOPE && function_name != NULL))
1697         {
1698           int static_memfuncp;
1699           char *tstr;
1700
1701           /* Method invocation : stuff "this" as first parameter.  */
1702           argvec[1] = arg2;
1703
1704           if (op != OP_SCOPE)
1705             {
1706               /* Name of method from expression.  */
1707               tstr = &exp->elts[pc2 + 2].string;
1708             }
1709           else
1710             tstr = function_name;
1711
1712           if (overload_resolution && (exp->language_defn->la_language
1713                                       == language_cplus))
1714             {
1715               /* Language is C++, do some overload resolution before
1716                  evaluation.  */
1717               struct value *valp = NULL;
1718
1719               (void) find_overload_match (&argvec[1], nargs, tstr,
1720                                           METHOD, /* method */
1721                                           0,      /* strict match */
1722                                           &arg2,  /* the object */
1723                                           NULL, &valp, NULL,
1724                                           &static_memfuncp, 0);
1725
1726               if (op == OP_SCOPE && !static_memfuncp)
1727                 {
1728                   /* For the time being, we don't handle this.  */
1729                   error (_("Call to overloaded function %s requires "
1730                            "`this' pointer"),
1731                          function_name);
1732                 }
1733               argvec[1] = arg2; /* the ``this'' pointer */
1734               argvec[0] = valp; /* Use the method found after overload
1735                                    resolution.  */
1736             }
1737           else
1738             /* Non-C++ case -- or no overload resolution.  */
1739             {
1740               struct value *temp = arg2;
1741
1742               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1743                                             &static_memfuncp,
1744                                             op == STRUCTOP_STRUCT
1745                                        ? "structure" : "structure pointer");
1746               /* value_struct_elt updates temp with the correct value
1747                  of the ``this'' pointer if necessary, so modify argvec[1] to
1748                  reflect any ``this'' changes.  */
1749               arg2
1750                 = value_from_longest (lookup_pointer_type(value_type (temp)),
1751                                       value_address (temp)
1752                                       + value_embedded_offset (temp));
1753               argvec[1] = arg2; /* the ``this'' pointer */
1754             }
1755
1756           if (static_memfuncp)
1757             {
1758               argvec[1] = argvec[0];
1759               nargs--;
1760               argvec++;
1761             }
1762         }
1763       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1764         {
1765           argvec[1] = arg2;
1766           argvec[0] = arg1;
1767         }
1768       else if (op == OP_VAR_VALUE || (op == OP_SCOPE && function != NULL))
1769         {
1770           /* Non-member function being called.  */
1771           /* fn: This can only be done for C++ functions.  A C-style function
1772              in a C++ program, for instance, does not have the fields that
1773              are expected here.  */
1774
1775           if (overload_resolution && (exp->language_defn->la_language
1776                                       == language_cplus))
1777             {
1778               /* Language is C++, do some overload resolution before
1779                  evaluation.  */
1780               struct symbol *symp;
1781               int no_adl = 0;
1782
1783               /* If a scope has been specified disable ADL.  */
1784               if (op == OP_SCOPE)
1785                 no_adl = 1;
1786
1787               if (op == OP_VAR_VALUE)
1788                 function = exp->elts[save_pos1+2].symbol;
1789
1790               (void) find_overload_match (&argvec[1], nargs,
1791                                           NULL,        /* no need for name */
1792                                           NON_METHOD,  /* not method */
1793                                           0,           /* strict match */
1794                                           NULL, function, /* the function */
1795                                           NULL, &symp, NULL, no_adl);
1796
1797               if (op == OP_VAR_VALUE)
1798                 {
1799                   /* Now fix the expression being evaluated.  */
1800                   exp->elts[save_pos1+2].symbol = symp;
1801                   argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1,
1802                                                              noside);
1803                 }
1804               else
1805                 argvec[0] = value_of_variable (symp, get_selected_block (0));
1806             }
1807           else
1808             {
1809               /* Not C++, or no overload resolution allowed.  */
1810               /* Nothing to be done; argvec already correctly set up.  */
1811             }
1812         }
1813       else
1814         {
1815           /* It is probably a C-style function.  */
1816           /* Nothing to be done; argvec already correctly set up.  */
1817         }
1818
1819     do_call_it:
1820
1821       if (noside == EVAL_SKIP)
1822         goto nosideret;
1823       if (argvec[0] == NULL)
1824         error (_("Cannot evaluate function -- may be inlined"));
1825       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1826         {
1827           /* If the return type doesn't look like a function type, call an
1828              error.  This can happen if somebody tries to turn a variable into
1829              a function call.  This is here because people often want to
1830              call, eg, strcmp, which gdb doesn't know is a function.  If
1831              gdb isn't asked for it's opinion (ie. through "whatis"),
1832              it won't offer it.  */
1833
1834           struct type *ftype = value_type (argvec[0]);
1835
1836           if (TYPE_CODE (ftype) == TYPE_CODE_INTERNAL_FUNCTION)
1837             {
1838               /* We don't know anything about what the internal
1839                  function might return, but we have to return
1840                  something.  */
1841               return value_zero (builtin_type (exp->gdbarch)->builtin_int,
1842                                  not_lval);
1843             }
1844           else if (TYPE_GNU_IFUNC (ftype))
1845             return allocate_value (TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype)));
1846           else if (TYPE_TARGET_TYPE (ftype))
1847             return allocate_value (TYPE_TARGET_TYPE (ftype));
1848           else
1849             error (_("Expression of type other than "
1850                      "\"Function returning ...\" used as function"));
1851         }
1852       if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_INTERNAL_FUNCTION)
1853         return call_internal_function (exp->gdbarch, exp->language_defn,
1854                                        argvec[0], nargs, argvec + 1);
1855
1856       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1857       /* pai: FIXME save value from call_function_by_hand, then adjust
1858          pc by adjust_fn_pc if +ve.  */
1859
1860     case OP_F77_UNDETERMINED_ARGLIST:
1861
1862       /* Remember that in F77, functions, substring ops and
1863          array subscript operations cannot be disambiguated
1864          at parse time.  We have made all array subscript operations,
1865          substring operations as well as function calls  come here
1866          and we now have to discover what the heck this thing actually was.
1867          If it is a function, we process just as if we got an OP_FUNCALL.  */
1868
1869       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1870       (*pos) += 2;
1871
1872       /* First determine the type code we are dealing with.  */
1873       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1874       type = check_typedef (value_type (arg1));
1875       code = TYPE_CODE (type);
1876
1877       if (code == TYPE_CODE_PTR)
1878         {
1879           /* Fortran always passes variable to subroutines as pointer.
1880              So we need to look into its target type to see if it is
1881              array, string or function.  If it is, we need to switch
1882              to the target value the original one points to.  */
1883           struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1884
1885           if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1886               || TYPE_CODE (target_type) == TYPE_CODE_STRING
1887               || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1888             {
1889               arg1 = value_ind (arg1);
1890               type = check_typedef (value_type (arg1));
1891               code = TYPE_CODE (type);
1892             }
1893         }
1894
1895       switch (code)
1896         {
1897         case TYPE_CODE_ARRAY:
1898           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1899             return value_f90_subarray (arg1, exp, pos, noside);
1900           else
1901             goto multi_f77_subscript;
1902
1903         case TYPE_CODE_STRING:
1904           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1905             return value_f90_subarray (arg1, exp, pos, noside);
1906           else
1907             {
1908               arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1909               return value_subscript (arg1, value_as_long (arg2));
1910             }
1911
1912         case TYPE_CODE_PTR:
1913         case TYPE_CODE_FUNC:
1914           /* It's a function call.  */
1915           /* Allocate arg vector, including space for the function to be
1916              called in argvec[0] and a terminating NULL.  */
1917           argvec = (struct value **)
1918             alloca (sizeof (struct value *) * (nargs + 2));
1919           argvec[0] = arg1;
1920           tem = 1;
1921           for (; tem <= nargs; tem++)
1922             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1923           argvec[tem] = 0;      /* signal end of arglist */
1924           goto do_call_it;
1925
1926         default:
1927           error (_("Cannot perform substring on this type"));
1928         }
1929
1930     case OP_COMPLEX:
1931       /* We have a complex number, There should be 2 floating
1932          point numbers that compose it.  */
1933       (*pos) += 2;
1934       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1935       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1936
1937       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1938
1939     case STRUCTOP_STRUCT:
1940       tem = longest_to_int (exp->elts[pc + 1].longconst);
1941       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1942       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1943       if (noside == EVAL_SKIP)
1944         goto nosideret;
1945       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1946         return value_zero (lookup_struct_elt_type (value_type (arg1),
1947                                                    &exp->elts[pc + 2].string,
1948                                                    0),
1949                            lval_memory);
1950       else
1951         {
1952           struct value *temp = arg1;
1953
1954           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1955                                    NULL, "structure");
1956         }
1957
1958     case STRUCTOP_PTR:
1959       tem = longest_to_int (exp->elts[pc + 1].longconst);
1960       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1961       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1962       if (noside == EVAL_SKIP)
1963         goto nosideret;
1964
1965       /* Check to see if operator '->' has been overloaded.  If so replace
1966          arg1 with the value returned by evaluating operator->().  */
1967       while (unop_user_defined_p (op, arg1))
1968         {
1969           volatile struct gdb_exception except;
1970           struct value *value = NULL;
1971           TRY_CATCH (except, RETURN_MASK_ERROR)
1972             {
1973               value = value_x_unop (arg1, op, noside);
1974             }
1975
1976           if (except.reason < 0)
1977             {
1978               if (except.error == NOT_FOUND_ERROR)
1979                 break;
1980               else
1981                 throw_exception (except);
1982             }
1983           arg1 = value;
1984         }
1985
1986       /* JYG: if print object is on we need to replace the base type
1987          with rtti type in order to continue on with successful
1988          lookup of member / method only available in the rtti type.  */
1989       {
1990         struct type *type = value_type (arg1);
1991         struct type *real_type;
1992         int full, top, using_enc;
1993         struct value_print_options opts;
1994
1995         get_user_print_options (&opts);
1996         if (opts.objectprint && TYPE_TARGET_TYPE(type)
1997             && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1998           {
1999             real_type = value_rtti_indirect_type (arg1, &full, &top,
2000                                                   &using_enc);
2001             if (real_type)
2002                 arg1 = value_cast (real_type, arg1);
2003           }
2004       }
2005
2006       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2007         return value_zero (lookup_struct_elt_type (value_type (arg1),
2008                                                    &exp->elts[pc + 2].string,
2009                                                    0),
2010                            lval_memory);
2011       else
2012         {
2013           struct value *temp = arg1;
2014
2015           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
2016                                    NULL, "structure pointer");
2017         }
2018
2019     case STRUCTOP_MEMBER:
2020     case STRUCTOP_MPTR:
2021       if (op == STRUCTOP_MEMBER)
2022         arg1 = evaluate_subexp_for_address (exp, pos, noside);
2023       else
2024         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2025
2026       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2027
2028       if (noside == EVAL_SKIP)
2029         goto nosideret;
2030
2031       type = check_typedef (value_type (arg2));
2032       switch (TYPE_CODE (type))
2033         {
2034         case TYPE_CODE_METHODPTR:
2035           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2036             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
2037           else
2038             {
2039               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
2040               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
2041               return value_ind (arg2);
2042             }
2043
2044         case TYPE_CODE_MEMBERPTR:
2045           /* Now, convert these values to an address.  */
2046           arg1 = value_cast_pointers (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
2047                                       arg1, 1);
2048
2049           mem_offset = value_as_long (arg2);
2050
2051           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2052                                      value_as_long (arg1) + mem_offset);
2053           return value_ind (arg3);
2054
2055         default:
2056           error (_("non-pointer-to-member value used "
2057                    "in pointer-to-member construct"));
2058         }
2059
2060     case TYPE_INSTANCE:
2061       nargs = longest_to_int (exp->elts[pc + 1].longconst);
2062       arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
2063       for (ix = 0; ix < nargs; ++ix)
2064         arg_types[ix] = exp->elts[pc + 1 + ix + 1].type;
2065
2066       expect_type = make_params (nargs, arg_types);
2067       *(pos) += 3 + nargs;
2068       arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
2069       xfree (TYPE_FIELDS (expect_type));
2070       xfree (TYPE_MAIN_TYPE (expect_type));
2071       xfree (expect_type);
2072       return arg1;
2073
2074     case BINOP_CONCAT:
2075       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2076       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2077       if (noside == EVAL_SKIP)
2078         goto nosideret;
2079       if (binop_user_defined_p (op, arg1, arg2))
2080         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2081       else
2082         return value_concat (arg1, arg2);
2083
2084     case BINOP_ASSIGN:
2085       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2086       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2087
2088       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2089         return arg1;
2090       if (binop_user_defined_p (op, arg1, arg2))
2091         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2092       else
2093         return value_assign (arg1, arg2);
2094
2095     case BINOP_ASSIGN_MODIFY:
2096       (*pos) += 2;
2097       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2098       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2099       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2100         return arg1;
2101       op = exp->elts[pc + 1].opcode;
2102       if (binop_user_defined_p (op, arg1, arg2))
2103         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
2104       else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
2105                                                   value_type (arg1))
2106                && is_integral_type (value_type (arg2)))
2107         arg2 = value_ptradd (arg1, value_as_long (arg2));
2108       else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
2109                                                   value_type (arg1))
2110                && is_integral_type (value_type (arg2)))
2111         arg2 = value_ptradd (arg1, - value_as_long (arg2));
2112       else
2113         {
2114           struct value *tmp = arg1;
2115
2116           /* For shift and integer exponentiation operations,
2117              only promote the first argument.  */
2118           if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2119               && is_integral_type (value_type (arg2)))
2120             unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2121           else
2122             binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2123
2124           arg2 = value_binop (tmp, arg2, op);
2125         }
2126       return value_assign (arg1, arg2);
2127
2128     case BINOP_ADD:
2129       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2130       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2131       if (noside == EVAL_SKIP)
2132         goto nosideret;
2133       if (binop_user_defined_p (op, arg1, arg2))
2134         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2135       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2136                && is_integral_type (value_type (arg2)))
2137         return value_ptradd (arg1, value_as_long (arg2));
2138       else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2139                && is_integral_type (value_type (arg1)))
2140         return value_ptradd (arg2, value_as_long (arg1));
2141       else
2142         {
2143           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2144           return value_binop (arg1, arg2, BINOP_ADD);
2145         }
2146
2147     case BINOP_SUB:
2148       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2149       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2150       if (noside == EVAL_SKIP)
2151         goto nosideret;
2152       if (binop_user_defined_p (op, arg1, arg2))
2153         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2154       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2155                && ptrmath_type_p (exp->language_defn, value_type (arg2)))
2156         {
2157           /* FIXME -- should be ptrdiff_t */
2158           type = builtin_type (exp->gdbarch)->builtin_long;
2159           return value_from_longest (type, value_ptrdiff (arg1, arg2));
2160         }
2161       else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2162                && is_integral_type (value_type (arg2)))
2163         return value_ptradd (arg1, - value_as_long (arg2));
2164       else
2165         {
2166           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2167           return value_binop (arg1, arg2, BINOP_SUB);
2168         }
2169
2170     case BINOP_EXP:
2171     case BINOP_MUL:
2172     case BINOP_DIV:
2173     case BINOP_INTDIV:
2174     case BINOP_REM:
2175     case BINOP_MOD:
2176     case BINOP_LSH:
2177     case BINOP_RSH:
2178     case BINOP_BITWISE_AND:
2179     case BINOP_BITWISE_IOR:
2180     case BINOP_BITWISE_XOR:
2181       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2182       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2183       if (noside == EVAL_SKIP)
2184         goto nosideret;
2185       if (binop_user_defined_p (op, arg1, arg2))
2186         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2187       else
2188         {
2189           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2190              fudge arg2 to avoid division-by-zero, the caller is
2191              (theoretically) only looking for the type of the result.  */
2192           if (noside == EVAL_AVOID_SIDE_EFFECTS
2193               /* ??? Do we really want to test for BINOP_MOD here?
2194                  The implementation of value_binop gives it a well-defined
2195                  value.  */
2196               && (op == BINOP_DIV
2197                   || op == BINOP_INTDIV
2198                   || op == BINOP_REM
2199                   || op == BINOP_MOD)
2200               && value_logical_not (arg2))
2201             {
2202               struct value *v_one, *retval;
2203
2204               v_one = value_one (value_type (arg2));
2205               binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
2206               retval = value_binop (arg1, v_one, op);
2207               return retval;
2208             }
2209           else
2210             {
2211               /* For shift and integer exponentiation operations,
2212                  only promote the first argument.  */
2213               if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2214                   && is_integral_type (value_type (arg2)))
2215                 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2216               else
2217                 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2218
2219               return value_binop (arg1, arg2, op);
2220             }
2221         }
2222
2223     case BINOP_RANGE:
2224       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2225       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2226       if (noside == EVAL_SKIP)
2227         goto nosideret;
2228       error (_("':' operator used in invalid context"));
2229
2230     case BINOP_SUBSCRIPT:
2231       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2232       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2233       if (noside == EVAL_SKIP)
2234         goto nosideret;
2235       if (binop_user_defined_p (op, arg1, arg2))
2236         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2237       else
2238         {
2239           /* If the user attempts to subscript something that is not an
2240              array or pointer type (like a plain int variable for example),
2241              then report this as an error.  */
2242
2243           arg1 = coerce_ref (arg1);
2244           type = check_typedef (value_type (arg1));
2245           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
2246               && TYPE_CODE (type) != TYPE_CODE_PTR)
2247             {
2248               if (TYPE_NAME (type))
2249                 error (_("cannot subscript something of type `%s'"),
2250                        TYPE_NAME (type));
2251               else
2252                 error (_("cannot subscript requested type"));
2253             }
2254
2255           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2256             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2257           else
2258             return value_subscript (arg1, value_as_long (arg2));
2259         }
2260
2261     case BINOP_IN:
2262       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2263       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2264       if (noside == EVAL_SKIP)
2265         goto nosideret;
2266       type = language_bool_type (exp->language_defn, exp->gdbarch);
2267       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
2268
2269     case MULTI_SUBSCRIPT:
2270       (*pos) += 2;
2271       nargs = longest_to_int (exp->elts[pc + 1].longconst);
2272       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2273       while (nargs-- > 0)
2274         {
2275           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2276           /* FIXME:  EVAL_SKIP handling may not be correct.  */
2277           if (noside == EVAL_SKIP)
2278             {
2279               if (nargs > 0)
2280                 {
2281                   continue;
2282                 }
2283               else
2284                 {
2285                   goto nosideret;
2286                 }
2287             }
2288           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct.  */
2289           if (noside == EVAL_AVOID_SIDE_EFFECTS)
2290             {
2291               /* If the user attempts to subscript something that has no target
2292                  type (like a plain int variable for example), then report this
2293                  as an error.  */
2294
2295               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
2296               if (type != NULL)
2297                 {
2298                   arg1 = value_zero (type, VALUE_LVAL (arg1));
2299                   noside = EVAL_SKIP;
2300                   continue;
2301                 }
2302               else
2303                 {
2304                   error (_("cannot subscript something of type `%s'"),
2305                          TYPE_NAME (value_type (arg1)));
2306                 }
2307             }
2308
2309           if (binop_user_defined_p (op, arg1, arg2))
2310             {
2311               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2312             }
2313           else
2314             {
2315               arg1 = coerce_ref (arg1);
2316               type = check_typedef (value_type (arg1));
2317
2318               switch (TYPE_CODE (type))
2319                 {
2320                 case TYPE_CODE_PTR:
2321                 case TYPE_CODE_ARRAY:
2322                 case TYPE_CODE_STRING:
2323                   arg1 = value_subscript (arg1, value_as_long (arg2));
2324                   break;
2325
2326                 default:
2327                   if (TYPE_NAME (type))
2328                     error (_("cannot subscript something of type `%s'"),
2329                            TYPE_NAME (type));
2330                   else
2331                     error (_("cannot subscript requested type"));
2332                 }
2333             }
2334         }
2335       return (arg1);
2336
2337     multi_f77_subscript:
2338       {
2339         LONGEST subscript_array[MAX_FORTRAN_DIMS];
2340         int ndimensions = 1, i;
2341         struct value *array = arg1;
2342
2343         if (nargs > MAX_FORTRAN_DIMS)
2344           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2345
2346         ndimensions = calc_f77_array_dims (type);
2347
2348         if (nargs != ndimensions)
2349           error (_("Wrong number of subscripts"));
2350
2351         gdb_assert (nargs > 0);
2352
2353         /* Now that we know we have a legal array subscript expression
2354            let us actually find out where this element exists in the array.  */
2355
2356         /* Take array indices left to right.  */
2357         for (i = 0; i < nargs; i++)
2358           {
2359             /* Evaluate each subscript; it must be a legal integer in F77.  */
2360             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2361
2362             /* Fill in the subscript array.  */
2363
2364             subscript_array[i] = value_as_long (arg2);
2365           }
2366
2367         /* Internal type of array is arranged right to left.  */
2368         for (i = nargs; i > 0; i--)
2369           {
2370             struct type *array_type = check_typedef (value_type (array));
2371             LONGEST index = subscript_array[i - 1];
2372
2373             lower = f77_get_lowerbound (array_type);
2374             array = value_subscripted_rvalue (array, index, lower);
2375           }
2376
2377         return array;
2378       }
2379
2380     case BINOP_LOGICAL_AND:
2381       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2382       if (noside == EVAL_SKIP)
2383         {
2384           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2385           goto nosideret;
2386         }
2387
2388       oldpos = *pos;
2389       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2390       *pos = oldpos;
2391
2392       if (binop_user_defined_p (op, arg1, arg2))
2393         {
2394           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2395           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2396         }
2397       else
2398         {
2399           tem = value_logical_not (arg1);
2400           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2401                                   (tem ? EVAL_SKIP : noside));
2402           type = language_bool_type (exp->language_defn, exp->gdbarch);
2403           return value_from_longest (type,
2404                              (LONGEST) (!tem && !value_logical_not (arg2)));
2405         }
2406
2407     case BINOP_LOGICAL_OR:
2408       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2409       if (noside == EVAL_SKIP)
2410         {
2411           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2412           goto nosideret;
2413         }
2414
2415       oldpos = *pos;
2416       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2417       *pos = oldpos;
2418
2419       if (binop_user_defined_p (op, arg1, arg2))
2420         {
2421           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2422           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2423         }
2424       else
2425         {
2426           tem = value_logical_not (arg1);
2427           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2428                                   (!tem ? EVAL_SKIP : noside));
2429           type = language_bool_type (exp->language_defn, exp->gdbarch);
2430           return value_from_longest (type,
2431                              (LONGEST) (!tem || !value_logical_not (arg2)));
2432         }
2433
2434     case BINOP_EQUAL:
2435       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2436       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2437       if (noside == EVAL_SKIP)
2438         goto nosideret;
2439       if (binop_user_defined_p (op, arg1, arg2))
2440         {
2441           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2442         }
2443       else
2444         {
2445           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2446           tem = value_equal (arg1, arg2);
2447           type = language_bool_type (exp->language_defn, exp->gdbarch);
2448           return value_from_longest (type, (LONGEST) tem);
2449         }
2450
2451     case BINOP_NOTEQUAL:
2452       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2453       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2454       if (noside == EVAL_SKIP)
2455         goto nosideret;
2456       if (binop_user_defined_p (op, arg1, arg2))
2457         {
2458           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2459         }
2460       else
2461         {
2462           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2463           tem = value_equal (arg1, arg2);
2464           type = language_bool_type (exp->language_defn, exp->gdbarch);
2465           return value_from_longest (type, (LONGEST) ! tem);
2466         }
2467
2468     case BINOP_LESS:
2469       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2470       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2471       if (noside == EVAL_SKIP)
2472         goto nosideret;
2473       if (binop_user_defined_p (op, arg1, arg2))
2474         {
2475           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2476         }
2477       else
2478         {
2479           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2480           tem = value_less (arg1, arg2);
2481           type = language_bool_type (exp->language_defn, exp->gdbarch);
2482           return value_from_longest (type, (LONGEST) tem);
2483         }
2484
2485     case BINOP_GTR:
2486       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2487       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2488       if (noside == EVAL_SKIP)
2489         goto nosideret;
2490       if (binop_user_defined_p (op, arg1, arg2))
2491         {
2492           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2493         }
2494       else
2495         {
2496           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2497           tem = value_less (arg2, arg1);
2498           type = language_bool_type (exp->language_defn, exp->gdbarch);
2499           return value_from_longest (type, (LONGEST) tem);
2500         }
2501
2502     case BINOP_GEQ:
2503       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2504       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2505       if (noside == EVAL_SKIP)
2506         goto nosideret;
2507       if (binop_user_defined_p (op, arg1, arg2))
2508         {
2509           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2510         }
2511       else
2512         {
2513           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2514           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2515           type = language_bool_type (exp->language_defn, exp->gdbarch);
2516           return value_from_longest (type, (LONGEST) tem);
2517         }
2518
2519     case BINOP_LEQ:
2520       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2521       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2522       if (noside == EVAL_SKIP)
2523         goto nosideret;
2524       if (binop_user_defined_p (op, arg1, arg2))
2525         {
2526           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2527         }
2528       else
2529         {
2530           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2531           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2532           type = language_bool_type (exp->language_defn, exp->gdbarch);
2533           return value_from_longest (type, (LONGEST) tem);
2534         }
2535
2536     case BINOP_REPEAT:
2537       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2538       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2539       if (noside == EVAL_SKIP)
2540         goto nosideret;
2541       type = check_typedef (value_type (arg2));
2542       if (TYPE_CODE (type) != TYPE_CODE_INT)
2543         error (_("Non-integral right operand for \"@\" operator."));
2544       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2545         {
2546           return allocate_repeat_value (value_type (arg1),
2547                                      longest_to_int (value_as_long (arg2)));
2548         }
2549       else
2550         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2551
2552     case BINOP_COMMA:
2553       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2554       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2555
2556     case UNOP_PLUS:
2557       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2558       if (noside == EVAL_SKIP)
2559         goto nosideret;
2560       if (unop_user_defined_p (op, arg1))
2561         return value_x_unop (arg1, op, noside);
2562       else
2563         {
2564           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2565           return value_pos (arg1);
2566         }
2567
2568     case UNOP_NEG:
2569       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2570       if (noside == EVAL_SKIP)
2571         goto nosideret;
2572       if (unop_user_defined_p (op, arg1))
2573         return value_x_unop (arg1, op, noside);
2574       else
2575         {
2576           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2577           return value_neg (arg1);
2578         }
2579
2580     case UNOP_COMPLEMENT:
2581       /* C++: check for and handle destructor names.  */
2582       op = exp->elts[*pos].opcode;
2583
2584       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2585       if (noside == EVAL_SKIP)
2586         goto nosideret;
2587       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2588         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2589       else
2590         {
2591           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2592           return value_complement (arg1);
2593         }
2594
2595     case UNOP_LOGICAL_NOT:
2596       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2597       if (noside == EVAL_SKIP)
2598         goto nosideret;
2599       if (unop_user_defined_p (op, arg1))
2600         return value_x_unop (arg1, op, noside);
2601       else
2602         {
2603           type = language_bool_type (exp->language_defn, exp->gdbarch);
2604           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2605         }
2606
2607     case UNOP_IND:
2608       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2609         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2610       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2611       type = check_typedef (value_type (arg1));
2612       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2613           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2614         error (_("Attempt to dereference pointer "
2615                  "to member without an object"));
2616       if (noside == EVAL_SKIP)
2617         goto nosideret;
2618       if (unop_user_defined_p (op, arg1))
2619         return value_x_unop (arg1, op, noside);
2620       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2621         {
2622           type = check_typedef (value_type (arg1));
2623           if (TYPE_CODE (type) == TYPE_CODE_PTR
2624               || TYPE_CODE (type) == TYPE_CODE_REF
2625           /* In C you can dereference an array to get the 1st elt.  */
2626               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2627             )
2628             return value_zero (TYPE_TARGET_TYPE (type),
2629                                lval_memory);
2630           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2631             /* GDB allows dereferencing an int.  */
2632             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2633                                lval_memory);
2634           else
2635             error (_("Attempt to take contents of a non-pointer value."));
2636         }
2637
2638       /* Allow * on an integer so we can cast it to whatever we want.
2639          This returns an int, which seems like the most C-like thing to
2640          do.  "long long" variables are rare enough that
2641          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2642       if (TYPE_CODE (type) == TYPE_CODE_INT)
2643         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2644                               (CORE_ADDR) value_as_address (arg1));
2645       return value_ind (arg1);
2646
2647     case UNOP_ADDR:
2648       /* C++: check for and handle pointer to members.  */
2649
2650       op = exp->elts[*pos].opcode;
2651
2652       if (noside == EVAL_SKIP)
2653         {
2654           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2655           goto nosideret;
2656         }
2657       else
2658         {
2659           struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2660                                                                noside);
2661
2662           return retvalp;
2663         }
2664
2665     case UNOP_SIZEOF:
2666       if (noside == EVAL_SKIP)
2667         {
2668           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2669           goto nosideret;
2670         }
2671       return evaluate_subexp_for_sizeof (exp, pos);
2672
2673     case UNOP_CAST:
2674       (*pos) += 2;
2675       type = exp->elts[pc + 1].type;
2676       arg1 = evaluate_subexp (type, exp, pos, noside);
2677       if (noside == EVAL_SKIP)
2678         goto nosideret;
2679       if (type != value_type (arg1))
2680         arg1 = value_cast (type, arg1);
2681       return arg1;
2682
2683     case UNOP_CAST_TYPE:
2684       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2685       type = value_type (arg1);
2686       arg1 = evaluate_subexp (type, exp, pos, noside);
2687       if (noside == EVAL_SKIP)
2688         goto nosideret;
2689       if (type != value_type (arg1))
2690         arg1 = value_cast (type, arg1);
2691       return arg1;
2692
2693     case UNOP_DYNAMIC_CAST:
2694       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2695       type = value_type (arg1);
2696       arg1 = evaluate_subexp (type, exp, pos, noside);
2697       if (noside == EVAL_SKIP)
2698         goto nosideret;
2699       return value_dynamic_cast (type, arg1);
2700
2701     case UNOP_REINTERPRET_CAST:
2702       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2703       type = value_type (arg1);
2704       arg1 = evaluate_subexp (type, exp, pos, noside);
2705       if (noside == EVAL_SKIP)
2706         goto nosideret;
2707       return value_reinterpret_cast (type, arg1);
2708
2709     case UNOP_MEMVAL:
2710       (*pos) += 2;
2711       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2712       if (noside == EVAL_SKIP)
2713         goto nosideret;
2714       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2715         return value_zero (exp->elts[pc + 1].type, lval_memory);
2716       else
2717         return value_at_lazy (exp->elts[pc + 1].type,
2718                               value_as_address (arg1));
2719
2720     case UNOP_MEMVAL_TYPE:
2721       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2722       type = value_type (arg1);
2723       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2724       if (noside == EVAL_SKIP)
2725         goto nosideret;
2726       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2727         return value_zero (type, lval_memory);
2728       else
2729         return value_at_lazy (type, value_as_address (arg1));
2730
2731     case UNOP_MEMVAL_TLS:
2732       (*pos) += 3;
2733       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2734       if (noside == EVAL_SKIP)
2735         goto nosideret;
2736       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2737         return value_zero (exp->elts[pc + 2].type, lval_memory);
2738       else
2739         {
2740           CORE_ADDR tls_addr;
2741
2742           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2743                                                    value_as_address (arg1));
2744           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2745         }
2746
2747     case UNOP_PREINCREMENT:
2748       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2749       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2750         return arg1;
2751       else if (unop_user_defined_p (op, arg1))
2752         {
2753           return value_x_unop (arg1, op, noside);
2754         }
2755       else
2756         {
2757           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2758             arg2 = value_ptradd (arg1, 1);
2759           else
2760             {
2761               struct value *tmp = arg1;
2762
2763               arg2 = value_one (value_type (arg1));
2764               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2765               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2766             }
2767
2768           return value_assign (arg1, arg2);
2769         }
2770
2771     case UNOP_PREDECREMENT:
2772       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2773       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2774         return arg1;
2775       else if (unop_user_defined_p (op, arg1))
2776         {
2777           return value_x_unop (arg1, op, noside);
2778         }
2779       else
2780         {
2781           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2782             arg2 = value_ptradd (arg1, -1);
2783           else
2784             {
2785               struct value *tmp = arg1;
2786
2787               arg2 = value_one (value_type (arg1));
2788               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2789               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2790             }
2791
2792           return value_assign (arg1, arg2);
2793         }
2794
2795     case UNOP_POSTINCREMENT:
2796       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2797       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2798         return arg1;
2799       else if (unop_user_defined_p (op, arg1))
2800         {
2801           return value_x_unop (arg1, op, noside);
2802         }
2803       else
2804         {
2805           arg3 = value_non_lval (arg1);
2806
2807           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2808             arg2 = value_ptradd (arg1, 1);
2809           else
2810             {
2811               struct value *tmp = arg1;
2812
2813               arg2 = value_one (value_type (arg1));
2814               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2815               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2816             }
2817
2818           value_assign (arg1, arg2);
2819           return arg3;
2820         }
2821
2822     case UNOP_POSTDECREMENT:
2823       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2824       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2825         return arg1;
2826       else if (unop_user_defined_p (op, arg1))
2827         {
2828           return value_x_unop (arg1, op, noside);
2829         }
2830       else
2831         {
2832           arg3 = value_non_lval (arg1);
2833
2834           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2835             arg2 = value_ptradd (arg1, -1);
2836           else
2837             {
2838               struct value *tmp = arg1;
2839
2840               arg2 = value_one (value_type (arg1));
2841               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2842               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2843             }
2844
2845           value_assign (arg1, arg2);
2846           return arg3;
2847         }
2848
2849     case OP_THIS:
2850       (*pos) += 1;
2851       return value_of_this (exp->language_defn);
2852
2853     case OP_TYPE:
2854       /* The value is not supposed to be used.  This is here to make it
2855          easier to accommodate expressions that contain types.  */
2856       (*pos) += 2;
2857       if (noside == EVAL_SKIP)
2858         goto nosideret;
2859       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2860         {
2861           struct type *type = exp->elts[pc + 1].type;
2862
2863           /* If this is a typedef, then find its immediate target.  We
2864              use check_typedef to resolve stubs, but we ignore its
2865              result because we do not want to dig past all
2866              typedefs.  */
2867           check_typedef (type);
2868           if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
2869             type = TYPE_TARGET_TYPE (type);
2870           return allocate_value (type);
2871         }
2872       else
2873         error (_("Attempt to use a type name as an expression"));
2874
2875     case OP_TYPEOF:
2876     case OP_DECLTYPE:
2877       if (noside == EVAL_SKIP)
2878         {
2879           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2880           goto nosideret;
2881         }
2882       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2883         {
2884           enum exp_opcode sub_op = exp->elts[*pos].opcode;
2885           struct value *result;
2886
2887           result = evaluate_subexp (NULL_TYPE, exp, pos,
2888                                     EVAL_AVOID_SIDE_EFFECTS);
2889
2890           /* 'decltype' has special semantics for lvalues.  */
2891           if (op == OP_DECLTYPE
2892               && (sub_op == BINOP_SUBSCRIPT
2893                   || sub_op == STRUCTOP_MEMBER
2894                   || sub_op == STRUCTOP_MPTR
2895                   || sub_op == UNOP_IND
2896                   || sub_op == STRUCTOP_STRUCT
2897                   || sub_op == STRUCTOP_PTR
2898                   || sub_op == OP_SCOPE))
2899             {
2900               struct type *type = value_type (result);
2901
2902               if (TYPE_CODE (check_typedef (type)) != TYPE_CODE_REF)
2903                 {
2904                   type = lookup_reference_type (type);
2905                   result = allocate_value (type);
2906                 }
2907             }
2908
2909           return result;
2910         }
2911       else
2912         error (_("Attempt to use a type as an expression"));
2913
2914     default:
2915       /* Removing this case and compiling with gcc -Wall reveals that
2916          a lot of cases are hitting this case.  Some of these should
2917          probably be removed from expression.h; others are legitimate
2918          expressions which are (apparently) not fully implemented.
2919
2920          If there are any cases landing here which mean a user error,
2921          then they should be separate cases, with more descriptive
2922          error messages.  */
2923
2924       error (_("GDB does not (yet) know how to "
2925                "evaluate that kind of expression"));
2926     }
2927
2928 nosideret:
2929   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
2930 }
2931 \f
2932 /* Evaluate a subexpression of EXP, at index *POS,
2933    and return the address of that subexpression.
2934    Advance *POS over the subexpression.
2935    If the subexpression isn't an lvalue, get an error.
2936    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2937    then only the type of the result need be correct.  */
2938
2939 static struct value *
2940 evaluate_subexp_for_address (struct expression *exp, int *pos,
2941                              enum noside noside)
2942 {
2943   enum exp_opcode op;
2944   int pc;
2945   struct symbol *var;
2946   struct value *x;
2947   int tem;
2948
2949   pc = (*pos);
2950   op = exp->elts[pc].opcode;
2951
2952   switch (op)
2953     {
2954     case UNOP_IND:
2955       (*pos)++;
2956       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2957
2958       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2959       if (unop_user_defined_p (op, x))
2960         {
2961           x = value_x_unop (x, op, noside);
2962           goto default_case_after_eval;
2963         }
2964
2965       return coerce_array (x);
2966
2967     case UNOP_MEMVAL:
2968       (*pos) += 3;
2969       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2970                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2971
2972     case UNOP_MEMVAL_TYPE:
2973       {
2974         struct type *type;
2975
2976         (*pos) += 1;
2977         x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2978         type = value_type (x);
2979         return value_cast (lookup_pointer_type (type),
2980                            evaluate_subexp (NULL_TYPE, exp, pos, noside));
2981       }
2982
2983     case OP_VAR_VALUE:
2984       var = exp->elts[pc + 2].symbol;
2985
2986       /* C++: The "address" of a reference should yield the address
2987        * of the object pointed to.  Let value_addr() deal with it.  */
2988       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2989         goto default_case;
2990
2991       (*pos) += 4;
2992       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2993         {
2994           struct type *type =
2995             lookup_pointer_type (SYMBOL_TYPE (var));
2996           enum address_class sym_class = SYMBOL_CLASS (var);
2997
2998           if (sym_class == LOC_CONST
2999               || sym_class == LOC_CONST_BYTES
3000               || sym_class == LOC_REGISTER)
3001             error (_("Attempt to take address of register or constant."));
3002
3003           return
3004             value_zero (type, not_lval);
3005         }
3006       else
3007         return address_of_variable (var, exp->elts[pc + 1].block);
3008
3009     case OP_SCOPE:
3010       tem = longest_to_int (exp->elts[pc + 2].longconst);
3011       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
3012       x = value_aggregate_elt (exp->elts[pc + 1].type,
3013                                &exp->elts[pc + 3].string,
3014                                NULL, 1, noside);
3015       if (x == NULL)
3016         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
3017       return x;
3018
3019     default:
3020     default_case:
3021       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
3022     default_case_after_eval:
3023       if (noside == EVAL_AVOID_SIDE_EFFECTS)
3024         {
3025           struct type *type = check_typedef (value_type (x));
3026
3027           if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
3028             return value_zero (lookup_pointer_type (value_type (x)),
3029                                not_lval);
3030           else if (TYPE_CODE (type) == TYPE_CODE_REF)
3031             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3032                                not_lval);
3033           else
3034             error (_("Attempt to take address of "
3035                      "value not located in memory."));
3036         }
3037       return value_addr (x);
3038     }
3039 }
3040
3041 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
3042    When used in contexts where arrays will be coerced anyway, this is
3043    equivalent to `evaluate_subexp' but much faster because it avoids
3044    actually fetching array contents (perhaps obsolete now that we have
3045    value_lazy()).
3046
3047    Note that we currently only do the coercion for C expressions, where
3048    arrays are zero based and the coercion is correct.  For other languages,
3049    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
3050    to decide if coercion is appropriate.  */
3051
3052 struct value *
3053 evaluate_subexp_with_coercion (struct expression *exp,
3054                                int *pos, enum noside noside)
3055 {
3056   enum exp_opcode op;
3057   int pc;
3058   struct value *val;
3059   struct symbol *var;
3060   struct type *type;
3061
3062   pc = (*pos);
3063   op = exp->elts[pc].opcode;
3064
3065   switch (op)
3066     {
3067     case OP_VAR_VALUE:
3068       var = exp->elts[pc + 2].symbol;
3069       type = check_typedef (SYMBOL_TYPE (var));
3070       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
3071           && !TYPE_VECTOR (type)
3072           && CAST_IS_CONVERSION (exp->language_defn))
3073         {
3074           (*pos) += 4;
3075           val = address_of_variable (var, exp->elts[pc + 1].block);
3076           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3077                              val);
3078         }
3079       /* FALLTHROUGH */
3080
3081     default:
3082       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
3083     }
3084 }
3085
3086 /* Evaluate a subexpression of EXP, at index *POS,
3087    and return a value for the size of that subexpression.
3088    Advance *POS over the subexpression.  */
3089
3090 static struct value *
3091 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
3092 {
3093   /* FIXME: This should be size_t.  */
3094   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3095   enum exp_opcode op;
3096   int pc;
3097   struct type *type;
3098   struct value *val;
3099
3100   pc = (*pos);
3101   op = exp->elts[pc].opcode;
3102
3103   switch (op)
3104     {
3105       /* This case is handled specially
3106          so that we avoid creating a value for the result type.
3107          If the result type is very big, it's desirable not to
3108          create a value unnecessarily.  */
3109     case UNOP_IND:
3110       (*pos)++;
3111       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3112       type = check_typedef (value_type (val));
3113       if (TYPE_CODE (type) != TYPE_CODE_PTR
3114           && TYPE_CODE (type) != TYPE_CODE_REF
3115           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3116         error (_("Attempt to take contents of a non-pointer value."));
3117       type = check_typedef (TYPE_TARGET_TYPE (type));
3118       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3119
3120     case UNOP_MEMVAL:
3121       (*pos) += 3;
3122       type = check_typedef (exp->elts[pc + 1].type);
3123       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3124
3125     case UNOP_MEMVAL_TYPE:
3126       (*pos) += 1;
3127       val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3128       type = check_typedef (value_type (val));
3129       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3130
3131     case OP_VAR_VALUE:
3132       (*pos) += 4;
3133       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
3134       return
3135         value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3136
3137     default:
3138       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3139       return value_from_longest (size_type,
3140                                  (LONGEST) TYPE_LENGTH (value_type (val)));
3141     }
3142 }
3143
3144 /* Parse a type expression in the string [P..P+LENGTH).  */
3145
3146 struct type *
3147 parse_and_eval_type (char *p, int length)
3148 {
3149   char *tmp = (char *) alloca (length + 4);
3150   struct expression *expr;
3151
3152   tmp[0] = '(';
3153   memcpy (tmp + 1, p, length);
3154   tmp[length + 1] = ')';
3155   tmp[length + 2] = '0';
3156   tmp[length + 3] = '\0';
3157   expr = parse_expression (tmp);
3158   if (expr->elts[0].opcode != UNOP_CAST)
3159     error (_("Internal error in eval_type."));
3160   return expr->elts[1].type;
3161 }
3162
3163 int
3164 calc_f77_array_dims (struct type *array_type)
3165 {
3166   int ndimen = 1;
3167   struct type *tmp_type;
3168
3169   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3170     error (_("Can't get dimensions for a non-array type"));
3171
3172   tmp_type = array_type;
3173
3174   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3175     {
3176       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3177         ++ndimen;
3178     }
3179   return ndimen;
3180 }