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