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                 case TYPE_CODE_BITSTRING:
2327                   type = language_bool_type (exp->language_defn, exp->gdbarch);
2328                   arg1 = value_bitstring_subscript (type, arg1,
2329                                                     value_as_long (arg2));
2330                   break;
2331
2332                 default:
2333                   if (TYPE_NAME (type))
2334                     error (_("cannot subscript something of type `%s'"),
2335                            TYPE_NAME (type));
2336                   else
2337                     error (_("cannot subscript requested type"));
2338                 }
2339             }
2340         }
2341       return (arg1);
2342
2343     multi_f77_subscript:
2344       {
2345         LONGEST subscript_array[MAX_FORTRAN_DIMS];
2346         int ndimensions = 1, i;
2347         struct value *array = arg1;
2348
2349         if (nargs > MAX_FORTRAN_DIMS)
2350           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2351
2352         ndimensions = calc_f77_array_dims (type);
2353
2354         if (nargs != ndimensions)
2355           error (_("Wrong number of subscripts"));
2356
2357         gdb_assert (nargs > 0);
2358
2359         /* Now that we know we have a legal array subscript expression
2360            let us actually find out where this element exists in the array.  */
2361
2362         /* Take array indices left to right.  */
2363         for (i = 0; i < nargs; i++)
2364           {
2365             /* Evaluate each subscript; it must be a legal integer in F77.  */
2366             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2367
2368             /* Fill in the subscript array.  */
2369
2370             subscript_array[i] = value_as_long (arg2);
2371           }
2372
2373         /* Internal type of array is arranged right to left.  */
2374         for (i = nargs; i > 0; i--)
2375           {
2376             struct type *array_type = check_typedef (value_type (array));
2377             LONGEST index = subscript_array[i - 1];
2378
2379             lower = f77_get_lowerbound (array_type);
2380             array = value_subscripted_rvalue (array, index, lower);
2381           }
2382
2383         return array;
2384       }
2385
2386     case BINOP_LOGICAL_AND:
2387       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2388       if (noside == EVAL_SKIP)
2389         {
2390           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2391           goto nosideret;
2392         }
2393
2394       oldpos = *pos;
2395       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2396       *pos = oldpos;
2397
2398       if (binop_user_defined_p (op, arg1, arg2))
2399         {
2400           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2401           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2402         }
2403       else
2404         {
2405           tem = value_logical_not (arg1);
2406           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2407                                   (tem ? EVAL_SKIP : noside));
2408           type = language_bool_type (exp->language_defn, exp->gdbarch);
2409           return value_from_longest (type,
2410                              (LONGEST) (!tem && !value_logical_not (arg2)));
2411         }
2412
2413     case BINOP_LOGICAL_OR:
2414       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2415       if (noside == EVAL_SKIP)
2416         {
2417           evaluate_subexp (NULL_TYPE, exp, pos, noside);
2418           goto nosideret;
2419         }
2420
2421       oldpos = *pos;
2422       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2423       *pos = oldpos;
2424
2425       if (binop_user_defined_p (op, arg1, arg2))
2426         {
2427           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2428           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2429         }
2430       else
2431         {
2432           tem = value_logical_not (arg1);
2433           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2434                                   (!tem ? EVAL_SKIP : noside));
2435           type = language_bool_type (exp->language_defn, exp->gdbarch);
2436           return value_from_longest (type,
2437                              (LONGEST) (!tem || !value_logical_not (arg2)));
2438         }
2439
2440     case BINOP_EQUAL:
2441       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2442       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2443       if (noside == EVAL_SKIP)
2444         goto nosideret;
2445       if (binop_user_defined_p (op, arg1, arg2))
2446         {
2447           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2448         }
2449       else
2450         {
2451           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2452           tem = value_equal (arg1, arg2);
2453           type = language_bool_type (exp->language_defn, exp->gdbarch);
2454           return value_from_longest (type, (LONGEST) tem);
2455         }
2456
2457     case BINOP_NOTEQUAL:
2458       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2459       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2460       if (noside == EVAL_SKIP)
2461         goto nosideret;
2462       if (binop_user_defined_p (op, arg1, arg2))
2463         {
2464           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2465         }
2466       else
2467         {
2468           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2469           tem = value_equal (arg1, arg2);
2470           type = language_bool_type (exp->language_defn, exp->gdbarch);
2471           return value_from_longest (type, (LONGEST) ! tem);
2472         }
2473
2474     case BINOP_LESS:
2475       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2476       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2477       if (noside == EVAL_SKIP)
2478         goto nosideret;
2479       if (binop_user_defined_p (op, arg1, arg2))
2480         {
2481           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2482         }
2483       else
2484         {
2485           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2486           tem = value_less (arg1, arg2);
2487           type = language_bool_type (exp->language_defn, exp->gdbarch);
2488           return value_from_longest (type, (LONGEST) tem);
2489         }
2490
2491     case BINOP_GTR:
2492       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2493       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2494       if (noside == EVAL_SKIP)
2495         goto nosideret;
2496       if (binop_user_defined_p (op, arg1, arg2))
2497         {
2498           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2499         }
2500       else
2501         {
2502           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2503           tem = value_less (arg2, arg1);
2504           type = language_bool_type (exp->language_defn, exp->gdbarch);
2505           return value_from_longest (type, (LONGEST) tem);
2506         }
2507
2508     case BINOP_GEQ:
2509       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2510       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2511       if (noside == EVAL_SKIP)
2512         goto nosideret;
2513       if (binop_user_defined_p (op, arg1, arg2))
2514         {
2515           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2516         }
2517       else
2518         {
2519           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2520           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2521           type = language_bool_type (exp->language_defn, exp->gdbarch);
2522           return value_from_longest (type, (LONGEST) tem);
2523         }
2524
2525     case BINOP_LEQ:
2526       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2527       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2528       if (noside == EVAL_SKIP)
2529         goto nosideret;
2530       if (binop_user_defined_p (op, arg1, arg2))
2531         {
2532           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2533         }
2534       else
2535         {
2536           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2537           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2538           type = language_bool_type (exp->language_defn, exp->gdbarch);
2539           return value_from_longest (type, (LONGEST) tem);
2540         }
2541
2542     case BINOP_REPEAT:
2543       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2544       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2545       if (noside == EVAL_SKIP)
2546         goto nosideret;
2547       type = check_typedef (value_type (arg2));
2548       if (TYPE_CODE (type) != TYPE_CODE_INT)
2549         error (_("Non-integral right operand for \"@\" operator."));
2550       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2551         {
2552           return allocate_repeat_value (value_type (arg1),
2553                                      longest_to_int (value_as_long (arg2)));
2554         }
2555       else
2556         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2557
2558     case BINOP_COMMA:
2559       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2560       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2561
2562     case UNOP_PLUS:
2563       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2564       if (noside == EVAL_SKIP)
2565         goto nosideret;
2566       if (unop_user_defined_p (op, arg1))
2567         return value_x_unop (arg1, op, noside);
2568       else
2569         {
2570           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2571           return value_pos (arg1);
2572         }
2573
2574     case UNOP_NEG:
2575       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2576       if (noside == EVAL_SKIP)
2577         goto nosideret;
2578       if (unop_user_defined_p (op, arg1))
2579         return value_x_unop (arg1, op, noside);
2580       else
2581         {
2582           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2583           return value_neg (arg1);
2584         }
2585
2586     case UNOP_COMPLEMENT:
2587       /* C++: check for and handle destructor names.  */
2588       op = exp->elts[*pos].opcode;
2589
2590       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2591       if (noside == EVAL_SKIP)
2592         goto nosideret;
2593       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2594         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2595       else
2596         {
2597           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2598           return value_complement (arg1);
2599         }
2600
2601     case UNOP_LOGICAL_NOT:
2602       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2603       if (noside == EVAL_SKIP)
2604         goto nosideret;
2605       if (unop_user_defined_p (op, arg1))
2606         return value_x_unop (arg1, op, noside);
2607       else
2608         {
2609           type = language_bool_type (exp->language_defn, exp->gdbarch);
2610           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2611         }
2612
2613     case UNOP_IND:
2614       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2615         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2616       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2617       type = check_typedef (value_type (arg1));
2618       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2619           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2620         error (_("Attempt to dereference pointer "
2621                  "to member without an object"));
2622       if (noside == EVAL_SKIP)
2623         goto nosideret;
2624       if (unop_user_defined_p (op, arg1))
2625         return value_x_unop (arg1, op, noside);
2626       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2627         {
2628           type = check_typedef (value_type (arg1));
2629           if (TYPE_CODE (type) == TYPE_CODE_PTR
2630               || TYPE_CODE (type) == TYPE_CODE_REF
2631           /* In C you can dereference an array to get the 1st elt.  */
2632               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2633             )
2634             return value_zero (TYPE_TARGET_TYPE (type),
2635                                lval_memory);
2636           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2637             /* GDB allows dereferencing an int.  */
2638             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2639                                lval_memory);
2640           else
2641             error (_("Attempt to take contents of a non-pointer value."));
2642         }
2643
2644       /* Allow * on an integer so we can cast it to whatever we want.
2645          This returns an int, which seems like the most C-like thing to
2646          do.  "long long" variables are rare enough that
2647          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2648       if (TYPE_CODE (type) == TYPE_CODE_INT)
2649         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2650                               (CORE_ADDR) value_as_address (arg1));
2651       return value_ind (arg1);
2652
2653     case UNOP_ADDR:
2654       /* C++: check for and handle pointer to members.  */
2655
2656       op = exp->elts[*pos].opcode;
2657
2658       if (noside == EVAL_SKIP)
2659         {
2660           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2661           goto nosideret;
2662         }
2663       else
2664         {
2665           struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2666                                                                noside);
2667
2668           return retvalp;
2669         }
2670
2671     case UNOP_SIZEOF:
2672       if (noside == EVAL_SKIP)
2673         {
2674           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2675           goto nosideret;
2676         }
2677       return evaluate_subexp_for_sizeof (exp, pos);
2678
2679     case UNOP_CAST:
2680       (*pos) += 2;
2681       type = exp->elts[pc + 1].type;
2682       arg1 = evaluate_subexp (type, exp, pos, noside);
2683       if (noside == EVAL_SKIP)
2684         goto nosideret;
2685       if (type != value_type (arg1))
2686         arg1 = value_cast (type, arg1);
2687       return arg1;
2688
2689     case UNOP_CAST_TYPE:
2690       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2691       type = value_type (arg1);
2692       arg1 = evaluate_subexp (type, exp, pos, noside);
2693       if (noside == EVAL_SKIP)
2694         goto nosideret;
2695       if (type != value_type (arg1))
2696         arg1 = value_cast (type, arg1);
2697       return arg1;
2698
2699     case UNOP_DYNAMIC_CAST:
2700       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2701       type = value_type (arg1);
2702       arg1 = evaluate_subexp (type, exp, pos, noside);
2703       if (noside == EVAL_SKIP)
2704         goto nosideret;
2705       return value_dynamic_cast (type, arg1);
2706
2707     case UNOP_REINTERPRET_CAST:
2708       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2709       type = value_type (arg1);
2710       arg1 = evaluate_subexp (type, exp, pos, noside);
2711       if (noside == EVAL_SKIP)
2712         goto nosideret;
2713       return value_reinterpret_cast (type, arg1);
2714
2715     case UNOP_MEMVAL:
2716       (*pos) += 2;
2717       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2718       if (noside == EVAL_SKIP)
2719         goto nosideret;
2720       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2721         return value_zero (exp->elts[pc + 1].type, lval_memory);
2722       else
2723         return value_at_lazy (exp->elts[pc + 1].type,
2724                               value_as_address (arg1));
2725
2726     case UNOP_MEMVAL_TYPE:
2727       arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2728       type = value_type (arg1);
2729       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2730       if (noside == EVAL_SKIP)
2731         goto nosideret;
2732       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2733         return value_zero (type, lval_memory);
2734       else
2735         return value_at_lazy (type, value_as_address (arg1));
2736
2737     case UNOP_MEMVAL_TLS:
2738       (*pos) += 3;
2739       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2740       if (noside == EVAL_SKIP)
2741         goto nosideret;
2742       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2743         return value_zero (exp->elts[pc + 2].type, lval_memory);
2744       else
2745         {
2746           CORE_ADDR tls_addr;
2747
2748           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2749                                                    value_as_address (arg1));
2750           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2751         }
2752
2753     case UNOP_PREINCREMENT:
2754       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2755       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2756         return arg1;
2757       else if (unop_user_defined_p (op, arg1))
2758         {
2759           return value_x_unop (arg1, op, noside);
2760         }
2761       else
2762         {
2763           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2764             arg2 = value_ptradd (arg1, 1);
2765           else
2766             {
2767               struct value *tmp = arg1;
2768
2769               arg2 = value_one (value_type (arg1));
2770               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2771               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2772             }
2773
2774           return value_assign (arg1, arg2);
2775         }
2776
2777     case UNOP_PREDECREMENT:
2778       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2779       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2780         return arg1;
2781       else if (unop_user_defined_p (op, arg1))
2782         {
2783           return value_x_unop (arg1, op, noside);
2784         }
2785       else
2786         {
2787           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2788             arg2 = value_ptradd (arg1, -1);
2789           else
2790             {
2791               struct value *tmp = arg1;
2792
2793               arg2 = value_one (value_type (arg1));
2794               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2795               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2796             }
2797
2798           return value_assign (arg1, arg2);
2799         }
2800
2801     case UNOP_POSTINCREMENT:
2802       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2803       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2804         return arg1;
2805       else if (unop_user_defined_p (op, arg1))
2806         {
2807           return value_x_unop (arg1, op, noside);
2808         }
2809       else
2810         {
2811           arg3 = value_non_lval (arg1);
2812
2813           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2814             arg2 = value_ptradd (arg1, 1);
2815           else
2816             {
2817               struct value *tmp = arg1;
2818
2819               arg2 = value_one (value_type (arg1));
2820               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2821               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2822             }
2823
2824           value_assign (arg1, arg2);
2825           return arg3;
2826         }
2827
2828     case UNOP_POSTDECREMENT:
2829       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2830       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2831         return arg1;
2832       else if (unop_user_defined_p (op, arg1))
2833         {
2834           return value_x_unop (arg1, op, noside);
2835         }
2836       else
2837         {
2838           arg3 = value_non_lval (arg1);
2839
2840           if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2841             arg2 = value_ptradd (arg1, -1);
2842           else
2843             {
2844               struct value *tmp = arg1;
2845
2846               arg2 = value_one (value_type (arg1));
2847               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2848               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2849             }
2850
2851           value_assign (arg1, arg2);
2852           return arg3;
2853         }
2854
2855     case OP_THIS:
2856       (*pos) += 1;
2857       return value_of_this (exp->language_defn);
2858
2859     case OP_TYPE:
2860       /* The value is not supposed to be used.  This is here to make it
2861          easier to accommodate expressions that contain types.  */
2862       (*pos) += 2;
2863       if (noside == EVAL_SKIP)
2864         goto nosideret;
2865       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2866         {
2867           struct type *type = exp->elts[pc + 1].type;
2868
2869           /* If this is a typedef, then find its immediate target.  We
2870              use check_typedef to resolve stubs, but we ignore its
2871              result because we do not want to dig past all
2872              typedefs.  */
2873           check_typedef (type);
2874           if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
2875             type = TYPE_TARGET_TYPE (type);
2876           return allocate_value (type);
2877         }
2878       else
2879         error (_("Attempt to use a type name as an expression"));
2880
2881     case OP_TYPEOF:
2882     case OP_DECLTYPE:
2883       if (noside == EVAL_SKIP)
2884         {
2885           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2886           goto nosideret;
2887         }
2888       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2889         {
2890           enum exp_opcode sub_op = exp->elts[*pos].opcode;
2891           struct value *result;
2892
2893           result = evaluate_subexp (NULL_TYPE, exp, pos,
2894                                     EVAL_AVOID_SIDE_EFFECTS);
2895
2896           /* 'decltype' has special semantics for lvalues.  */
2897           if (op == OP_DECLTYPE
2898               && (sub_op == BINOP_SUBSCRIPT
2899                   || sub_op == STRUCTOP_MEMBER
2900                   || sub_op == STRUCTOP_MPTR
2901                   || sub_op == UNOP_IND
2902                   || sub_op == STRUCTOP_STRUCT
2903                   || sub_op == STRUCTOP_PTR
2904                   || sub_op == OP_SCOPE))
2905             {
2906               struct type *type = value_type (result);
2907
2908               if (TYPE_CODE (check_typedef (type)) != TYPE_CODE_REF)
2909                 {
2910                   type = lookup_reference_type (type);
2911                   result = allocate_value (type);
2912                 }
2913             }
2914
2915           return result;
2916         }
2917       else
2918         error (_("Attempt to use a type as an expression"));
2919
2920     default:
2921       /* Removing this case and compiling with gcc -Wall reveals that
2922          a lot of cases are hitting this case.  Some of these should
2923          probably be removed from expression.h; others are legitimate
2924          expressions which are (apparently) not fully implemented.
2925
2926          If there are any cases landing here which mean a user error,
2927          then they should be separate cases, with more descriptive
2928          error messages.  */
2929
2930       error (_("GDB does not (yet) know how to "
2931                "evaluate that kind of expression"));
2932     }
2933
2934 nosideret:
2935   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
2936 }
2937 \f
2938 /* Evaluate a subexpression of EXP, at index *POS,
2939    and return the address of that subexpression.
2940    Advance *POS over the subexpression.
2941    If the subexpression isn't an lvalue, get an error.
2942    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2943    then only the type of the result need be correct.  */
2944
2945 static struct value *
2946 evaluate_subexp_for_address (struct expression *exp, int *pos,
2947                              enum noside noside)
2948 {
2949   enum exp_opcode op;
2950   int pc;
2951   struct symbol *var;
2952   struct value *x;
2953   int tem;
2954
2955   pc = (*pos);
2956   op = exp->elts[pc].opcode;
2957
2958   switch (op)
2959     {
2960     case UNOP_IND:
2961       (*pos)++;
2962       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2963
2964       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2965       if (unop_user_defined_p (op, x))
2966         {
2967           x = value_x_unop (x, op, noside);
2968           goto default_case_after_eval;
2969         }
2970
2971       return coerce_array (x);
2972
2973     case UNOP_MEMVAL:
2974       (*pos) += 3;
2975       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2976                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2977
2978     case UNOP_MEMVAL_TYPE:
2979       {
2980         struct type *type;
2981
2982         (*pos) += 1;
2983         x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2984         type = value_type (x);
2985         return value_cast (lookup_pointer_type (type),
2986                            evaluate_subexp (NULL_TYPE, exp, pos, noside));
2987       }
2988
2989     case OP_VAR_VALUE:
2990       var = exp->elts[pc + 2].symbol;
2991
2992       /* C++: The "address" of a reference should yield the address
2993        * of the object pointed to.  Let value_addr() deal with it.  */
2994       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2995         goto default_case;
2996
2997       (*pos) += 4;
2998       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2999         {
3000           struct type *type =
3001             lookup_pointer_type (SYMBOL_TYPE (var));
3002           enum address_class sym_class = SYMBOL_CLASS (var);
3003
3004           if (sym_class == LOC_CONST
3005               || sym_class == LOC_CONST_BYTES
3006               || sym_class == LOC_REGISTER)
3007             error (_("Attempt to take address of register or constant."));
3008
3009           return
3010             value_zero (type, not_lval);
3011         }
3012       else
3013         return address_of_variable (var, exp->elts[pc + 1].block);
3014
3015     case OP_SCOPE:
3016       tem = longest_to_int (exp->elts[pc + 2].longconst);
3017       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
3018       x = value_aggregate_elt (exp->elts[pc + 1].type,
3019                                &exp->elts[pc + 3].string,
3020                                NULL, 1, noside);
3021       if (x == NULL)
3022         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
3023       return x;
3024
3025     default:
3026     default_case:
3027       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
3028     default_case_after_eval:
3029       if (noside == EVAL_AVOID_SIDE_EFFECTS)
3030         {
3031           struct type *type = check_typedef (value_type (x));
3032
3033           if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
3034             return value_zero (lookup_pointer_type (value_type (x)),
3035                                not_lval);
3036           else if (TYPE_CODE (type) == TYPE_CODE_REF)
3037             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3038                                not_lval);
3039           else
3040             error (_("Attempt to take address of "
3041                      "value not located in memory."));
3042         }
3043       return value_addr (x);
3044     }
3045 }
3046
3047 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
3048    When used in contexts where arrays will be coerced anyway, this is
3049    equivalent to `evaluate_subexp' but much faster because it avoids
3050    actually fetching array contents (perhaps obsolete now that we have
3051    value_lazy()).
3052
3053    Note that we currently only do the coercion for C expressions, where
3054    arrays are zero based and the coercion is correct.  For other languages,
3055    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
3056    to decide if coercion is appropriate.  */
3057
3058 struct value *
3059 evaluate_subexp_with_coercion (struct expression *exp,
3060                                int *pos, enum noside noside)
3061 {
3062   enum exp_opcode op;
3063   int pc;
3064   struct value *val;
3065   struct symbol *var;
3066   struct type *type;
3067
3068   pc = (*pos);
3069   op = exp->elts[pc].opcode;
3070
3071   switch (op)
3072     {
3073     case OP_VAR_VALUE:
3074       var = exp->elts[pc + 2].symbol;
3075       type = check_typedef (SYMBOL_TYPE (var));
3076       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
3077           && !TYPE_VECTOR (type)
3078           && CAST_IS_CONVERSION (exp->language_defn))
3079         {
3080           (*pos) += 4;
3081           val = address_of_variable (var, exp->elts[pc + 1].block);
3082           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3083                              val);
3084         }
3085       /* FALLTHROUGH */
3086
3087     default:
3088       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
3089     }
3090 }
3091
3092 /* Evaluate a subexpression of EXP, at index *POS,
3093    and return a value for the size of that subexpression.
3094    Advance *POS over the subexpression.  */
3095
3096 static struct value *
3097 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
3098 {
3099   /* FIXME: This should be size_t.  */
3100   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3101   enum exp_opcode op;
3102   int pc;
3103   struct type *type;
3104   struct value *val;
3105
3106   pc = (*pos);
3107   op = exp->elts[pc].opcode;
3108
3109   switch (op)
3110     {
3111       /* This case is handled specially
3112          so that we avoid creating a value for the result type.
3113          If the result type is very big, it's desirable not to
3114          create a value unnecessarily.  */
3115     case UNOP_IND:
3116       (*pos)++;
3117       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3118       type = check_typedef (value_type (val));
3119       if (TYPE_CODE (type) != TYPE_CODE_PTR
3120           && TYPE_CODE (type) != TYPE_CODE_REF
3121           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3122         error (_("Attempt to take contents of a non-pointer value."));
3123       type = check_typedef (TYPE_TARGET_TYPE (type));
3124       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3125
3126     case UNOP_MEMVAL:
3127       (*pos) += 3;
3128       type = check_typedef (exp->elts[pc + 1].type);
3129       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3130
3131     case UNOP_MEMVAL_TYPE:
3132       (*pos) += 1;
3133       val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3134       type = check_typedef (value_type (val));
3135       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3136
3137     case OP_VAR_VALUE:
3138       (*pos) += 4;
3139       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
3140       return
3141         value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3142
3143     default:
3144       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3145       return value_from_longest (size_type,
3146                                  (LONGEST) TYPE_LENGTH (value_type (val)));
3147     }
3148 }
3149
3150 /* Parse a type expression in the string [P..P+LENGTH).  */
3151
3152 struct type *
3153 parse_and_eval_type (char *p, int length)
3154 {
3155   char *tmp = (char *) alloca (length + 4);
3156   struct expression *expr;
3157
3158   tmp[0] = '(';
3159   memcpy (tmp + 1, p, length);
3160   tmp[length + 1] = ')';
3161   tmp[length + 2] = '0';
3162   tmp[length + 3] = '\0';
3163   expr = parse_expression (tmp);
3164   if (expr->elts[0].opcode != UNOP_CAST)
3165     error (_("Internal error in eval_type."));
3166   return expr->elts[1].type;
3167 }
3168
3169 int
3170 calc_f77_array_dims (struct type *array_type)
3171 {
3172   int ndimen = 1;
3173   struct type *tmp_type;
3174
3175   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3176     error (_("Can't get dimensions for a non-array type"));
3177
3178   tmp_type = array_type;
3179
3180   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3181     {
3182       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3183         ++ndimen;
3184     }
3185   return ndimen;
3186 }