gdb/eval.c

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