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