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