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