contrib/gdb-7/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             /* Is it a high_level symbol?  */
1165
1166             sym = find_pc_function (addr);
1167             if (sym != NULL)
1168               method = value_of_variable (sym, 0);
1169           }
1170
1171         /* If we found a method with symbol information, check to see
1172            if it returns a struct.  Otherwise assume it doesn't.  */
1173
1174         if (method)
1175           {
1176             struct block *b;
1177             CORE_ADDR funaddr;
1178             struct type *val_type;
1179
1180             funaddr = find_function_addr (method, &val_type);
1181
1182             b = block_for_pc (funaddr);
1183
1184             CHECK_TYPEDEF (val_type);
1185
1186             if ((val_type == NULL)
1187                 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1188               {
1189                 if (expect_type != NULL)
1190                   val_type = expect_type;
1191               }
1192
1193             struct_return = using_struct_return (exp->gdbarch,
1194                                                  value_type (method), val_type);
1195           }
1196         else if (expect_type != NULL)
1197           {
1198             struct_return = using_struct_return (exp->gdbarch, NULL,
1199                                                  check_typedef (expect_type));
1200           }
1201
1202         /* Found a function symbol.  Now we will substitute its
1203            value in place of the message dispatcher (obj_msgSend),
1204            so that we call the method directly instead of thru
1205            the dispatcher.  The main reason for doing this is that
1206            we can now evaluate the return value and parameter values
1207            according to their known data types, in case we need to
1208            do things like promotion, dereferencing, special handling
1209            of structs and doubles, etc.
1210
1211            We want to use the type signature of 'method', but still
1212            jump to objc_msgSend() or objc_msgSend_stret() to better
1213            mimic the behavior of the runtime.  */
1214
1215         if (method)
1216           {
1217             if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1218               error (_("method address has symbol information with non-function type; skipping"));
1219             if (struct_return)
1220               set_value_address (method, value_as_address (msg_send_stret));
1221             else
1222               set_value_address (method, value_as_address (msg_send));
1223             called_method = method;
1224           }
1225         else
1226           {
1227             if (struct_return)
1228               called_method = msg_send_stret;
1229             else
1230               called_method = msg_send;
1231           }
1232
1233         if (noside == EVAL_SKIP)
1234           goto nosideret;
1235
1236         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1237           {
1238             /* If the return type doesn't look like a function type,
1239                call an error.  This can happen if somebody tries to
1240                turn a variable into a function call. This is here
1241                because people often want to call, eg, strcmp, which
1242                gdb doesn't know is a function.  If gdb isn't asked for
1243                it's opinion (ie. through "whatis"), it won't offer
1244                it. */
1245
1246             struct type *type = value_type (called_method);
1247             if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1248               type = TYPE_TARGET_TYPE (type);
1249             type = TYPE_TARGET_TYPE (type);
1250
1251             if (type)
1252             {
1253               if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1254                 return allocate_value (expect_type);
1255               else
1256                 return allocate_value (type);
1257             }
1258             else
1259               error (_("Expression of type other than \"method returning ...\" used as a method"));
1260           }
1261
1262         /* Now depending on whether we found a symbol for the method,
1263            we will either call the runtime dispatcher or the method
1264            directly.  */
1265
1266         argvec[0] = called_method;
1267         argvec[1] = target;
1268         argvec[2] = value_from_longest (long_type, selector);
1269         /* User-supplied arguments.  */
1270         for (tem = 0; tem < nargs; tem++)
1271           argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1272         argvec[tem + 3] = 0;
1273
1274         if (gnu_runtime && (method != NULL))
1275           {
1276             /* Function objc_msg_lookup returns a pointer.  */
1277             deprecated_set_value_type (argvec[0],
1278                                        lookup_function_type (lookup_pointer_type (value_type (argvec[0]))));
1279             argvec[0] = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1280           }
1281
1282         ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1283         return ret;
1284       }
1285       break;
1286
1287     case OP_FUNCALL:
1288       (*pos) += 2;
1289       op = exp->elts[*pos].opcode;
1290       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1291       /* Allocate arg vector, including space for the function to be
1292          called in argvec[0] and a terminating NULL */
1293       argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
1294       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1295         {
1296           nargs++;
1297           /* First, evaluate the structure into arg2 */
1298           pc2 = (*pos)++;
1299
1300           if (noside == EVAL_SKIP)
1301             goto nosideret;
1302
1303           if (op == STRUCTOP_MEMBER)
1304             {
1305               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1306             }
1307           else
1308             {
1309               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1310             }
1311
1312           /* If the function is a virtual function, then the
1313              aggregate value (providing the structure) plays
1314              its part by providing the vtable.  Otherwise,
1315              it is just along for the ride: call the function
1316              directly.  */
1317
1318           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1319
1320           if (TYPE_CODE (check_typedef (value_type (arg1)))
1321               != TYPE_CODE_METHODPTR)
1322             error (_("Non-pointer-to-member value used in pointer-to-member "
1323                      "construct"));
1324
1325           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1326             {
1327               struct type *method_type = check_typedef (value_type (arg1));
1328               arg1 = value_zero (method_type, not_lval);
1329             }
1330           else
1331             arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1332
1333           /* Now, say which argument to start evaluating from */
1334           tem = 2;
1335         }
1336       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1337         {
1338           /* Hair for method invocations */
1339           int tem2;
1340
1341           nargs++;
1342           /* First, evaluate the structure into arg2 */
1343           pc2 = (*pos)++;
1344           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1345           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1346           if (noside == EVAL_SKIP)
1347             goto nosideret;
1348
1349           if (op == STRUCTOP_STRUCT)
1350             {
1351               /* If v is a variable in a register, and the user types
1352                  v.method (), this will produce an error, because v has
1353                  no address.
1354
1355                  A possible way around this would be to allocate a
1356                  copy of the variable on the stack, copy in the
1357                  contents, call the function, and copy out the
1358                  contents.  I.e. convert this from call by reference
1359                  to call by copy-return (or whatever it's called).
1360                  However, this does not work because it is not the
1361                  same: the method being called could stash a copy of
1362                  the address, and then future uses through that address
1363                  (after the method returns) would be expected to
1364                  use the variable itself, not some copy of it.  */
1365               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1366             }
1367           else
1368             {
1369               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1370             }
1371           /* Now, say which argument to start evaluating from */
1372           tem = 2;
1373         }
1374       else
1375         {
1376           /* Non-method function call */
1377           save_pos1 = *pos;
1378           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1379           tem = 1;
1380           type = value_type (argvec[0]);
1381           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1382             type = TYPE_TARGET_TYPE (type);
1383           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1384             {
1385               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1386                 {
1387                   /* pai: FIXME This seems to be coercing arguments before
1388                    * overload resolution has been done! */
1389                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
1390                                                  exp, pos, noside);
1391                 }
1392             }
1393         }
1394
1395       /* Evaluate arguments */
1396       for (; tem <= nargs; tem++)
1397         {
1398           /* Ensure that array expressions are coerced into pointer objects. */
1399           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1400         }
1401
1402       /* signal end of arglist */
1403       argvec[tem] = 0;
1404
1405       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1406         {
1407           int static_memfuncp;
1408           char tstr[256];
1409
1410           /* Method invocation : stuff "this" as first parameter */
1411           argvec[1] = arg2;
1412           /* Name of method from expression */
1413           strcpy (tstr, &exp->elts[pc2 + 2].string);
1414
1415           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1416             {
1417               /* Language is C++, do some overload resolution before evaluation */
1418               struct value *valp = NULL;
1419
1420               /* Prepare list of argument types for overload resolution */
1421               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1422               for (ix = 1; ix <= nargs; ix++)
1423                 arg_types[ix - 1] = value_type (argvec[ix]);
1424
1425               (void) find_overload_match (arg_types, nargs, tstr,
1426                                      1 /* method */ , 0 /* strict match */ ,
1427                                           &arg2 /* the object */ , NULL,
1428                                           &valp, NULL, &static_memfuncp);
1429
1430
1431               argvec[1] = arg2; /* the ``this'' pointer */
1432               argvec[0] = valp; /* use the method found after overload resolution */
1433             }
1434           else
1435             /* Non-C++ case -- or no overload resolution */
1436             {
1437               struct value *temp = arg2;
1438               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1439                                             &static_memfuncp,
1440                                             op == STRUCTOP_STRUCT
1441                                        ? "structure" : "structure pointer");
1442               /* value_struct_elt updates temp with the correct value
1443                  of the ``this'' pointer if necessary, so modify argvec[1] to
1444                  reflect any ``this'' changes.  */
1445               arg2 = value_from_longest (lookup_pointer_type(value_type (temp)),
1446                                          value_address (temp)
1447                                          + value_embedded_offset (temp));
1448               argvec[1] = arg2; /* the ``this'' pointer */
1449             }
1450
1451           if (static_memfuncp)
1452             {
1453               argvec[1] = argvec[0];
1454               nargs--;
1455               argvec++;
1456             }
1457         }
1458       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1459         {
1460           argvec[1] = arg2;
1461           argvec[0] = arg1;
1462         }
1463       else if (op == OP_VAR_VALUE)
1464         {
1465           /* Non-member function being called */
1466           /* fn: This can only be done for C++ functions.  A C-style function
1467              in a C++ program, for instance, does not have the fields that
1468              are expected here */
1469
1470           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1471             {
1472               /* Language is C++, do some overload resolution before evaluation */
1473               struct symbol *symp;
1474
1475               /* Prepare list of argument types for overload resolution */
1476               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1477               for (ix = 1; ix <= nargs; ix++)
1478                 arg_types[ix - 1] = value_type (argvec[ix]);
1479
1480               (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
1481                                  0 /* not method */ , 0 /* strict match */ ,
1482                       NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
1483                                           NULL, &symp, NULL);
1484
1485               /* Now fix the expression being evaluated */
1486               exp->elts[save_pos1+2].symbol = symp;
1487               argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1488             }
1489           else
1490             {
1491               /* Not C++, or no overload resolution allowed */
1492               /* nothing to be done; argvec already correctly set up */
1493             }
1494         }
1495       else
1496         {
1497           /* It is probably a C-style function */
1498           /* nothing to be done; argvec already correctly set up */
1499         }
1500
1501     do_call_it:
1502
1503       if (noside == EVAL_SKIP)
1504         goto nosideret;
1505       if (argvec[0] == NULL)
1506         error (_("Cannot evaluate function -- may be inlined"));
1507       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1508         {
1509           /* If the return type doesn't look like a function type, call an
1510              error.  This can happen if somebody tries to turn a variable into
1511              a function call. This is here because people often want to
1512              call, eg, strcmp, which gdb doesn't know is a function.  If
1513              gdb isn't asked for it's opinion (ie. through "whatis"),
1514              it won't offer it. */
1515
1516           struct type *ftype = value_type (argvec[0]);
1517
1518           if (TYPE_CODE (ftype) == TYPE_CODE_INTERNAL_FUNCTION)
1519             {
1520               /* We don't know anything about what the internal
1521                  function might return, but we have to return
1522                  something.  */
1523               return value_zero (builtin_type (exp->gdbarch)->builtin_int,
1524                                  not_lval);
1525             }
1526           else if (TYPE_TARGET_TYPE (ftype))
1527             return allocate_value (TYPE_TARGET_TYPE (ftype));
1528           else
1529             error (_("Expression of type other than \"Function returning ...\" used as function"));
1530         }
1531       if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_INTERNAL_FUNCTION)
1532         return call_internal_function (exp->gdbarch, exp->language_defn,
1533                                        argvec[0], nargs, argvec + 1);
1534
1535       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1536       /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
1537
1538     case OP_F77_UNDETERMINED_ARGLIST:
1539
1540       /* Remember that in F77, functions, substring ops and
1541          array subscript operations cannot be disambiguated
1542          at parse time.  We have made all array subscript operations,
1543          substring operations as well as function calls  come here
1544          and we now have to discover what the heck this thing actually was.
1545          If it is a function, we process just as if we got an OP_FUNCALL. */
1546
1547       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1548       (*pos) += 2;
1549
1550       /* First determine the type code we are dealing with.  */
1551       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1552       type = check_typedef (value_type (arg1));
1553       code = TYPE_CODE (type);
1554
1555       if (code == TYPE_CODE_PTR)
1556         {
1557           /* Fortran always passes variable to subroutines as pointer.
1558              So we need to look into its target type to see if it is
1559              array, string or function.  If it is, we need to switch
1560              to the target value the original one points to.  */
1561           struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1562
1563           if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1564               || TYPE_CODE (target_type) == TYPE_CODE_STRING
1565               || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1566             {
1567               arg1 = value_ind (arg1);
1568               type = check_typedef (value_type (arg1));
1569               code = TYPE_CODE (type);
1570             }
1571         }
1572
1573       switch (code)
1574         {
1575         case TYPE_CODE_ARRAY:
1576           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1577             return value_f90_subarray (arg1, exp, pos, noside);
1578           else
1579             goto multi_f77_subscript;
1580
1581         case TYPE_CODE_STRING:
1582           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1583             return value_f90_subarray (arg1, exp, pos, noside);
1584           else
1585             {
1586               arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1587               return value_subscript (arg1, value_as_long (arg2));
1588             }
1589
1590         case TYPE_CODE_PTR:
1591         case TYPE_CODE_FUNC:
1592           /* It's a function call. */
1593           /* Allocate arg vector, including space for the function to be
1594              called in argvec[0] and a terminating NULL */
1595           argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
1596           argvec[0] = arg1;
1597           tem = 1;
1598           for (; tem <= nargs; tem++)
1599             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1600           argvec[tem] = 0;      /* signal end of arglist */
1601           goto do_call_it;
1602
1603         default:
1604           error (_("Cannot perform substring on this type"));
1605         }
1606
1607     case OP_COMPLEX:
1608       /* We have a complex number, There should be 2 floating
1609          point numbers that compose it */
1610       (*pos) += 2;
1611       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1612       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1613
1614       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1615
1616     case STRUCTOP_STRUCT:
1617       tem = longest_to_int (exp->elts[pc + 1].longconst);
1618       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1619       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1620       if (noside == EVAL_SKIP)
1621         goto nosideret;
1622       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1623         return value_zero (lookup_struct_elt_type (value_type (arg1),
1624                                                    &exp->elts[pc + 2].string,
1625                                                    0),
1626                            lval_memory);
1627       else
1628         {
1629           struct value *temp = arg1;
1630           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1631                                    NULL, "structure");
1632         }
1633
1634     case STRUCTOP_PTR:
1635       tem = longest_to_int (exp->elts[pc + 1].longconst);
1636       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1637       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1638       if (noside == EVAL_SKIP)
1639         goto nosideret;
1640
1641       /* JYG: if print object is on we need to replace the base type
1642          with rtti type in order to continue on with successful
1643          lookup of member / method only available in the rtti type. */
1644       {
1645         struct type *type = value_type (arg1);
1646         struct type *real_type;
1647         int full, top, using_enc;
1648         struct value_print_options opts;
1649
1650         get_user_print_options (&opts);
1651         if (opts.objectprint && TYPE_TARGET_TYPE(type) &&
1652             (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1653           {
1654             real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1655             if (real_type)
1656               {
1657                 if (TYPE_CODE (type) == TYPE_CODE_PTR)
1658                   real_type = lookup_pointer_type (real_type);
1659                 else
1660                   real_type = lookup_reference_type (real_type);
1661
1662                 arg1 = value_cast (real_type, arg1);
1663               }
1664           }
1665       }
1666
1667       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1668         return value_zero (lookup_struct_elt_type (value_type (arg1),
1669                                                    &exp->elts[pc + 2].string,
1670                                                    0),
1671                            lval_memory);
1672       else
1673         {
1674           struct value *temp = arg1;
1675           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1676                                    NULL, "structure pointer");
1677         }
1678
1679     case STRUCTOP_MEMBER:
1680     case STRUCTOP_MPTR:
1681       if (op == STRUCTOP_MEMBER)
1682         arg1 = evaluate_subexp_for_address (exp, pos, noside);
1683       else
1684         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1685
1686       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1687
1688       if (noside == EVAL_SKIP)
1689         goto nosideret;
1690
1691       type = check_typedef (value_type (arg2));
1692       switch (TYPE_CODE (type))
1693         {
1694         case TYPE_CODE_METHODPTR:
1695           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1696             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
1697           else
1698             {
1699               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
1700               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
1701               return value_ind (arg2);
1702             }
1703
1704         case TYPE_CODE_MEMBERPTR:
1705           /* Now, convert these values to an address.  */
1706           arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1707                              arg1);
1708
1709           mem_offset = value_as_long (arg2);
1710
1711           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1712                                      value_as_long (arg1) + mem_offset);
1713           return value_ind (arg3);
1714
1715         default:
1716           error (_("non-pointer-to-member value used in pointer-to-member construct"));
1717         }
1718
1719     case BINOP_CONCAT:
1720       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1721       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1722       if (noside == EVAL_SKIP)
1723         goto nosideret;
1724       if (binop_user_defined_p (op, arg1, arg2))
1725         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1726       else
1727         return value_concat (arg1, arg2);
1728
1729     case BINOP_ASSIGN:
1730       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1731       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1732
1733       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1734         return arg1;
1735       if (binop_user_defined_p (op, arg1, arg2))
1736         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1737       else
1738         return value_assign (arg1, arg2);
1739
1740     case BINOP_ASSIGN_MODIFY:
1741       (*pos) += 2;
1742       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1743       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1744       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1745         return arg1;
1746       op = exp->elts[pc + 1].opcode;
1747       if (binop_user_defined_p (op, arg1, arg2))
1748         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1749       else if (op == BINOP_ADD && ptrmath_type_p (value_type (arg1))
1750                && is_integral_type (value_type (arg2)))
1751         arg2 = value_ptradd (arg1, value_as_long (arg2));
1752       else if (op == BINOP_SUB && ptrmath_type_p (value_type (arg1))
1753                && is_integral_type (value_type (arg2)))
1754         arg2 = value_ptradd (arg1, - value_as_long (arg2));
1755       else
1756         {
1757           struct value *tmp = arg1;
1758
1759           /* For shift and integer exponentiation operations,
1760              only promote the first argument.  */
1761           if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
1762               && is_integral_type (value_type (arg2)))
1763             unop_promote (exp->language_defn, exp->gdbarch, &tmp);
1764           else
1765             binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
1766
1767           arg2 = value_binop (tmp, arg2, op);
1768         }
1769       return value_assign (arg1, arg2);
1770
1771     case BINOP_ADD:
1772       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1773       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1774       if (noside == EVAL_SKIP)
1775         goto nosideret;
1776       if (binop_user_defined_p (op, arg1, arg2))
1777         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1778       else if (ptrmath_type_p (value_type (arg1))
1779                && is_integral_type (value_type (arg2)))
1780         return value_ptradd (arg1, value_as_long (arg2));
1781       else if (ptrmath_type_p (value_type (arg2))
1782                && is_integral_type (value_type (arg1)))
1783         return value_ptradd (arg2, value_as_long (arg1));
1784       else
1785         {
1786           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
1787           return value_binop (arg1, arg2, BINOP_ADD);
1788         }
1789
1790     case BINOP_SUB:
1791       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1792       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1793       if (noside == EVAL_SKIP)
1794         goto nosideret;
1795       if (binop_user_defined_p (op, arg1, arg2))
1796         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1797       else if (ptrmath_type_p (value_type (arg1))
1798                && ptrmath_type_p (value_type (arg2)))
1799         {
1800           /* FIXME -- should be ptrdiff_t */
1801           type = builtin_type (exp->gdbarch)->builtin_long;
1802           return value_from_longest (type, value_ptrdiff (arg1, arg2));
1803         }
1804       else if (ptrmath_type_p (value_type (arg1))
1805                && is_integral_type (value_type (arg2)))
1806         return value_ptradd (arg1, - value_as_long (arg2));
1807       else
1808         {
1809           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
1810           return value_binop (arg1, arg2, BINOP_SUB);
1811         }
1812
1813     case BINOP_EXP:
1814     case BINOP_MUL:
1815     case BINOP_DIV:
1816     case BINOP_INTDIV:
1817     case BINOP_REM:
1818     case BINOP_MOD:
1819     case BINOP_LSH:
1820     case BINOP_RSH:
1821     case BINOP_BITWISE_AND:
1822     case BINOP_BITWISE_IOR:
1823     case BINOP_BITWISE_XOR:
1824       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1825       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1826       if (noside == EVAL_SKIP)
1827         goto nosideret;
1828       if (binop_user_defined_p (op, arg1, arg2))
1829         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1830       else
1831         {
1832           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
1833              fudge arg2 to avoid division-by-zero, the caller is
1834              (theoretically) only looking for the type of the result.  */
1835           if (noside == EVAL_AVOID_SIDE_EFFECTS
1836               /* ??? Do we really want to test for BINOP_MOD here?
1837                  The implementation of value_binop gives it a well-defined
1838                  value.  */
1839               && (op == BINOP_DIV
1840                   || op == BINOP_INTDIV
1841                   || op == BINOP_REM
1842                   || op == BINOP_MOD)
1843               && value_logical_not (arg2))
1844             {
1845               struct value *v_one, *retval;
1846
1847               v_one = value_one (value_type (arg2), not_lval);
1848               binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
1849               retval = value_binop (arg1, v_one, op);
1850               return retval;
1851             }
1852           else
1853             {
1854               /* For shift and integer exponentiation operations,
1855                  only promote the first argument.  */
1856               if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
1857                   && is_integral_type (value_type (arg2)))
1858                 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
1859               else
1860                 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
1861
1862               return value_binop (arg1, arg2, op);
1863             }
1864         }
1865
1866     case BINOP_RANGE:
1867       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1868       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1869       if (noside == EVAL_SKIP)
1870         goto nosideret;
1871       error (_("':' operator used in invalid context"));
1872
1873     case BINOP_SUBSCRIPT:
1874       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1875       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1876       if (noside == EVAL_SKIP)
1877         goto nosideret;
1878       if (binop_user_defined_p (op, arg1, arg2))
1879         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1880       else
1881         {
1882           /* If the user attempts to subscript something that is not an
1883              array or pointer type (like a plain int variable for example),
1884              then report this as an error. */
1885
1886           arg1 = coerce_ref (arg1);
1887           type = check_typedef (value_type (arg1));
1888           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1889               && TYPE_CODE (type) != TYPE_CODE_PTR)
1890             {
1891               if (TYPE_NAME (type))
1892                 error (_("cannot subscript something of type `%s'"),
1893                        TYPE_NAME (type));
1894               else
1895                 error (_("cannot subscript requested type"));
1896             }
1897
1898           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1899             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1900           else
1901             return value_subscript (arg1, value_as_long (arg2));
1902         }
1903
1904     case BINOP_IN:
1905       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1906       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1907       if (noside == EVAL_SKIP)
1908         goto nosideret;
1909       type = language_bool_type (exp->language_defn, exp->gdbarch);
1910       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
1911
1912     case MULTI_SUBSCRIPT:
1913       (*pos) += 2;
1914       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1915       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1916       while (nargs-- > 0)
1917         {
1918           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1919           /* FIXME:  EVAL_SKIP handling may not be correct. */
1920           if (noside == EVAL_SKIP)
1921             {
1922               if (nargs > 0)
1923                 {
1924                   continue;
1925                 }
1926               else
1927                 {
1928                   goto nosideret;
1929                 }
1930             }
1931           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1932           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1933             {
1934               /* If the user attempts to subscript something that has no target
1935                  type (like a plain int variable for example), then report this
1936                  as an error. */
1937
1938               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
1939               if (type != NULL)
1940                 {
1941                   arg1 = value_zero (type, VALUE_LVAL (arg1));
1942                   noside = EVAL_SKIP;
1943                   continue;
1944                 }
1945               else
1946                 {
1947                   error (_("cannot subscript something of type `%s'"),
1948                          TYPE_NAME (value_type (arg1)));
1949                 }
1950             }
1951
1952           if (binop_user_defined_p (op, arg1, arg2))
1953             {
1954               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1955             }
1956           else
1957             {
1958               arg1 = coerce_ref (arg1);
1959               type = check_typedef (value_type (arg1));
1960
1961               switch (TYPE_CODE (type))
1962                 {
1963                 case TYPE_CODE_PTR:
1964                 case TYPE_CODE_ARRAY:
1965                 case TYPE_CODE_STRING:
1966                   arg1 = value_subscript (arg1, value_as_long (arg2));
1967                   break;
1968
1969                 case TYPE_CODE_BITSTRING:
1970                   type = language_bool_type (exp->language_defn, exp->gdbarch);
1971                   arg1 = value_bitstring_subscript (type, arg1,
1972                                                     value_as_long (arg2));
1973                   break;
1974
1975                 default:
1976                   if (TYPE_NAME (type))
1977                     error (_("cannot subscript something of type `%s'"),
1978                            TYPE_NAME (type));
1979                   else
1980                     error (_("cannot subscript requested type"));
1981                 }
1982             }
1983         }
1984       return (arg1);
1985
1986     multi_f77_subscript:
1987       {
1988         int subscript_array[MAX_FORTRAN_DIMS];
1989         int array_size_array[MAX_FORTRAN_DIMS];
1990         int ndimensions = 1, i;
1991         struct type *tmp_type;
1992         int offset_item;        /* The array offset where the item lives */
1993
1994         if (nargs > MAX_FORTRAN_DIMS)
1995           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
1996
1997         tmp_type = check_typedef (value_type (arg1));
1998         ndimensions = calc_f77_array_dims (type);
1999
2000         if (nargs != ndimensions)
2001           error (_("Wrong number of subscripts"));
2002
2003         gdb_assert (nargs > 0);
2004
2005         /* Now that we know we have a legal array subscript expression
2006            let us actually find out where this element exists in the array. */
2007
2008         offset_item = 0;
2009         /* Take array indices left to right */
2010         for (i = 0; i < nargs; i++)
2011           {
2012             /* Evaluate each subscript, It must be a legal integer in F77 */
2013             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2014
2015             /* Fill in the subscript and array size arrays */
2016
2017             subscript_array[i] = value_as_long (arg2);
2018           }
2019
2020         /* Internal type of array is arranged right to left */
2021         for (i = 0; i < nargs; i++)
2022           {
2023             upper = f77_get_upperbound (tmp_type);
2024             lower = f77_get_lowerbound (tmp_type);
2025
2026             array_size_array[nargs - i - 1] = upper - lower + 1;
2027
2028             /* Zero-normalize subscripts so that offsetting will work. */
2029
2030             subscript_array[nargs - i - 1] -= lower;
2031
2032             /* If we are at the bottom of a multidimensional
2033                array type then keep a ptr to the last ARRAY
2034                type around for use when calling value_subscript()
2035                below. This is done because we pretend to value_subscript
2036                that we actually have a one-dimensional array
2037                of base element type that we apply a simple
2038                offset to. */
2039
2040             if (i < nargs - 1)
2041               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
2042           }
2043
2044         /* Now let us calculate the offset for this item */
2045
2046         offset_item = subscript_array[ndimensions - 1];
2047
2048         for (i = ndimensions - 1; i > 0; --i)
2049           offset_item =
2050             array_size_array[i - 1] * offset_item + subscript_array[i - 1];
2051
2052         /* Let us now play a dirty trick: we will take arg1
2053            which is a value node pointing to the topmost level
2054            of the multidimensional array-set and pretend
2055            that it is actually a array of the final element
2056            type, this will ensure that value_subscript()
2057            returns the correct type value */
2058
2059         deprecated_set_value_type (arg1, tmp_type);
2060         return value_subscripted_rvalue (arg1, offset_item, 0);
2061       }
2062
2063     case BINOP_LOGICAL_AND:
2064       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2065       if (noside == EVAL_SKIP)
2066         {
2067           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2068           goto nosideret;
2069         }
2070
2071       oldpos = *pos;
2072       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2073       *pos = oldpos;
2074
2075       if (binop_user_defined_p (op, arg1, arg2))
2076         {
2077           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2078           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2079         }
2080       else
2081         {
2082           tem = value_logical_not (arg1);
2083           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2084                                   (tem ? EVAL_SKIP : noside));
2085           type = language_bool_type (exp->language_defn, exp->gdbarch);
2086           return value_from_longest (type,
2087                              (LONGEST) (!tem && !value_logical_not (arg2)));
2088         }
2089
2090     case BINOP_LOGICAL_OR:
2091       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2092       if (noside == EVAL_SKIP)
2093         {
2094           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2095           goto nosideret;
2096         }
2097
2098       oldpos = *pos;
2099       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2100       *pos = oldpos;
2101
2102       if (binop_user_defined_p (op, arg1, arg2))
2103         {
2104           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2105           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2106         }
2107       else
2108         {
2109           tem = value_logical_not (arg1);
2110           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2111                                   (!tem ? EVAL_SKIP : noside));
2112           type = language_bool_type (exp->language_defn, exp->gdbarch);
2113           return value_from_longest (type,
2114                              (LONGEST) (!tem || !value_logical_not (arg2)));
2115         }
2116
2117     case BINOP_EQUAL:
2118       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2119       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2120       if (noside == EVAL_SKIP)
2121         goto nosideret;
2122       if (binop_user_defined_p (op, arg1, arg2))
2123         {
2124           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2125         }
2126       else
2127         {
2128           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2129           tem = value_equal (arg1, arg2);
2130           type = language_bool_type (exp->language_defn, exp->gdbarch);
2131           return value_from_longest (type, (LONGEST) tem);
2132         }
2133
2134     case BINOP_NOTEQUAL:
2135       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2136       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2137       if (noside == EVAL_SKIP)
2138         goto nosideret;
2139       if (binop_user_defined_p (op, arg1, arg2))
2140         {
2141           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2142         }
2143       else
2144         {
2145           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2146           tem = value_equal (arg1, arg2);
2147           type = language_bool_type (exp->language_defn, exp->gdbarch);
2148           return value_from_longest (type, (LONGEST) ! tem);
2149         }
2150
2151     case BINOP_LESS:
2152       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2153       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2154       if (noside == EVAL_SKIP)
2155         goto nosideret;
2156       if (binop_user_defined_p (op, arg1, arg2))
2157         {
2158           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2159         }
2160       else
2161         {
2162           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2163           tem = value_less (arg1, arg2);
2164           type = language_bool_type (exp->language_defn, exp->gdbarch);
2165           return value_from_longest (type, (LONGEST) tem);
2166         }
2167
2168     case BINOP_GTR:
2169       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2170       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2171       if (noside == EVAL_SKIP)
2172         goto nosideret;
2173       if (binop_user_defined_p (op, arg1, arg2))
2174         {
2175           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2176         }
2177       else
2178         {
2179           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2180           tem = value_less (arg2, arg1);
2181           type = language_bool_type (exp->language_defn, exp->gdbarch);
2182           return value_from_longest (type, (LONGEST) tem);
2183         }
2184
2185     case BINOP_GEQ:
2186       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2187       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2188       if (noside == EVAL_SKIP)
2189         goto nosideret;
2190       if (binop_user_defined_p (op, arg1, arg2))
2191         {
2192           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2193         }
2194       else
2195         {
2196           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2197           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2198           type = language_bool_type (exp->language_defn, exp->gdbarch);
2199           return value_from_longest (type, (LONGEST) tem);
2200         }
2201
2202     case BINOP_LEQ:
2203       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2204       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2205       if (noside == EVAL_SKIP)
2206         goto nosideret;
2207       if (binop_user_defined_p (op, arg1, arg2))
2208         {
2209           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2210         }
2211       else
2212         {
2213           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2214           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2215           type = language_bool_type (exp->language_defn, exp->gdbarch);
2216           return value_from_longest (type, (LONGEST) tem);
2217         }
2218
2219     case BINOP_REPEAT:
2220       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2221       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2222       if (noside == EVAL_SKIP)
2223         goto nosideret;
2224       type = check_typedef (value_type (arg2));
2225       if (TYPE_CODE (type) != TYPE_CODE_INT)
2226         error (_("Non-integral right operand for \"@\" operator."));
2227       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2228         {
2229           return allocate_repeat_value (value_type (arg1),
2230                                      longest_to_int (value_as_long (arg2)));
2231         }
2232       else
2233         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2234
2235     case BINOP_COMMA:
2236       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2237       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2238
2239     case UNOP_PLUS:
2240       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2241       if (noside == EVAL_SKIP)
2242         goto nosideret;
2243       if (unop_user_defined_p (op, arg1))
2244         return value_x_unop (arg1, op, noside);
2245       else
2246         {
2247           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2248           return value_pos (arg1);
2249         }
2250
2251     case UNOP_NEG:
2252       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2253       if (noside == EVAL_SKIP)
2254         goto nosideret;
2255       if (unop_user_defined_p (op, arg1))
2256         return value_x_unop (arg1, op, noside);
2257       else
2258         {
2259           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2260           return value_neg (arg1);
2261         }
2262
2263     case UNOP_COMPLEMENT:
2264       /* C++: check for and handle destructor names.  */
2265       op = exp->elts[*pos].opcode;
2266
2267       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2268       if (noside == EVAL_SKIP)
2269         goto nosideret;
2270       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2271         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2272       else
2273         {
2274           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2275           return value_complement (arg1);
2276         }
2277
2278     case UNOP_LOGICAL_NOT:
2279       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2280       if (noside == EVAL_SKIP)
2281         goto nosideret;
2282       if (unop_user_defined_p (op, arg1))
2283         return value_x_unop (arg1, op, noside);
2284       else
2285         {
2286           type = language_bool_type (exp->language_defn, exp->gdbarch);
2287           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2288         }
2289
2290     case UNOP_IND:
2291       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2292         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2293       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2294       type = check_typedef (value_type (arg1));
2295       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2296           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2297         error (_("Attempt to dereference pointer to member without an object"));
2298       if (noside == EVAL_SKIP)
2299         goto nosideret;
2300       if (unop_user_defined_p (op, arg1))
2301         return value_x_unop (arg1, op, noside);
2302       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2303         {
2304           type = check_typedef (value_type (arg1));
2305           if (TYPE_CODE (type) == TYPE_CODE_PTR
2306               || TYPE_CODE (type) == TYPE_CODE_REF
2307           /* In C you can dereference an array to get the 1st elt.  */
2308               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2309             )
2310             return value_zero (TYPE_TARGET_TYPE (type),
2311                                lval_memory);
2312           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2313             /* GDB allows dereferencing an int.  */
2314             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2315                                lval_memory);
2316           else
2317             error (_("Attempt to take contents of a non-pointer value."));
2318         }
2319
2320       /* Allow * on an integer so we can cast it to whatever we want.
2321          This returns an int, which seems like the most C-like thing to
2322          do.  "long long" variables are rare enough that
2323          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2324       if (TYPE_CODE (type) == TYPE_CODE_INT)
2325         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2326                               (CORE_ADDR) value_as_address (arg1));
2327       return value_ind (arg1);
2328
2329     case UNOP_ADDR:
2330       /* C++: check for and handle pointer to members.  */
2331
2332       op = exp->elts[*pos].opcode;
2333
2334       if (noside == EVAL_SKIP)
2335         {
2336           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2337           goto nosideret;
2338         }
2339       else
2340         {
2341           struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
2342           return retvalp;
2343         }
2344
2345     case UNOP_SIZEOF:
2346       if (noside == EVAL_SKIP)
2347         {
2348           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2349           goto nosideret;
2350         }
2351       return evaluate_subexp_for_sizeof (exp, pos);
2352
2353     case UNOP_CAST:
2354       (*pos) += 2;
2355       type = exp->elts[pc + 1].type;
2356       arg1 = evaluate_subexp (type, exp, pos, noside);
2357       if (noside == EVAL_SKIP)
2358         goto nosideret;
2359       if (type != value_type (arg1))
2360         arg1 = value_cast (type, arg1);
2361       return arg1;
2362
2363     case UNOP_MEMVAL:
2364       (*pos) += 2;
2365       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2366       if (noside == EVAL_SKIP)
2367         goto nosideret;
2368       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2369         return value_zero (exp->elts[pc + 1].type, lval_memory);
2370       else
2371         return value_at_lazy (exp->elts[pc + 1].type,
2372                               value_as_address (arg1));
2373
2374     case UNOP_MEMVAL_TLS:
2375       (*pos) += 3;
2376       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2377       if (noside == EVAL_SKIP)
2378         goto nosideret;
2379       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2380         return value_zero (exp->elts[pc + 2].type, lval_memory);
2381       else
2382         {
2383           CORE_ADDR tls_addr;
2384           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2385                                                    value_as_address (arg1));
2386           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2387         }
2388
2389     case UNOP_PREINCREMENT:
2390       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2391       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2392         return arg1;
2393       else if (unop_user_defined_p (op, arg1))
2394         {
2395           return value_x_unop (arg1, op, noside);
2396         }
2397       else
2398         {
2399           if (ptrmath_type_p (value_type (arg1)))
2400             arg2 = value_ptradd (arg1, 1);
2401           else
2402             {
2403               struct value *tmp = arg1;
2404               arg2 = value_one (value_type (arg1), not_lval);
2405               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2406               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2407             }
2408
2409           return value_assign (arg1, arg2);
2410         }
2411
2412     case UNOP_PREDECREMENT:
2413       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2414       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2415         return arg1;
2416       else if (unop_user_defined_p (op, arg1))
2417         {
2418           return value_x_unop (arg1, op, noside);
2419         }
2420       else
2421         {
2422           if (ptrmath_type_p (value_type (arg1)))
2423             arg2 = value_ptradd (arg1, -1);
2424           else
2425             {
2426               struct value *tmp = arg1;
2427               arg2 = value_one (value_type (arg1), not_lval);
2428               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2429               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2430             }
2431
2432           return value_assign (arg1, arg2);
2433         }
2434
2435     case UNOP_POSTINCREMENT:
2436       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2437       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2438         return arg1;
2439       else if (unop_user_defined_p (op, arg1))
2440         {
2441           return value_x_unop (arg1, op, noside);
2442         }
2443       else
2444         {
2445           if (ptrmath_type_p (value_type (arg1)))
2446             arg2 = value_ptradd (arg1, 1);
2447           else
2448             {
2449               struct value *tmp = arg1;
2450               arg2 = value_one (value_type (arg1), not_lval);
2451               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2452               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2453             }
2454
2455           value_assign (arg1, arg2);
2456           return arg1;
2457         }
2458
2459     case UNOP_POSTDECREMENT:
2460       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2461       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2462         return arg1;
2463       else if (unop_user_defined_p (op, arg1))
2464         {
2465           return value_x_unop (arg1, op, noside);
2466         }
2467       else
2468         {
2469           if (ptrmath_type_p (value_type (arg1)))
2470             arg2 = value_ptradd (arg1, -1);
2471           else
2472             {
2473               struct value *tmp = arg1;
2474               arg2 = value_one (value_type (arg1), not_lval);
2475               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2476               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2477             }
2478
2479           value_assign (arg1, arg2);
2480           return arg1;
2481         }
2482
2483     case OP_THIS:
2484       (*pos) += 1;
2485       return value_of_this (1);
2486
2487     case OP_OBJC_SELF:
2488       (*pos) += 1;
2489       return value_of_local ("self", 1);
2490
2491     case OP_TYPE:
2492       /* The value is not supposed to be used.  This is here to make it
2493          easier to accommodate expressions that contain types.  */
2494       (*pos) += 2;
2495       if (noside == EVAL_SKIP)
2496         goto nosideret;
2497       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2498         {
2499           struct type *type = exp->elts[pc + 1].type;
2500           /* If this is a typedef, then find its immediate target.  We
2501              use check_typedef to resolve stubs, but we ignore its
2502              result because we do not want to dig past all
2503              typedefs.  */
2504           check_typedef (type);
2505           if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
2506             type = TYPE_TARGET_TYPE (type);
2507           return allocate_value (type);
2508         }
2509       else
2510         error (_("Attempt to use a type name as an expression"));
2511
2512     default:
2513       /* Removing this case and compiling with gcc -Wall reveals that
2514          a lot of cases are hitting this case.  Some of these should
2515          probably be removed from expression.h; others are legitimate
2516          expressions which are (apparently) not fully implemented.
2517
2518          If there are any cases landing here which mean a user error,
2519          then they should be separate cases, with more descriptive
2520          error messages.  */
2521
2522       error (_("\
2523 GDB does not (yet) know how to evaluate that kind of expression"));
2524     }
2525
2526 nosideret:
2527   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
2528 }
2529 \f
2530 /* Evaluate a subexpression of EXP, at index *POS,
2531    and return the address of that subexpression.
2532    Advance *POS over the subexpression.
2533    If the subexpression isn't an lvalue, get an error.
2534    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2535    then only the type of the result need be correct.  */
2536
2537 static struct value *
2538 evaluate_subexp_for_address (struct expression *exp, int *pos,
2539                              enum noside noside)
2540 {
2541   enum exp_opcode op;
2542   int pc;
2543   struct symbol *var;
2544   struct value *x;
2545   int tem;
2546
2547   pc = (*pos);
2548   op = exp->elts[pc].opcode;
2549
2550   switch (op)
2551     {
2552     case UNOP_IND:
2553       (*pos)++;
2554       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2555
2556       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2557       if (unop_user_defined_p (op, x))
2558         {
2559           x = value_x_unop (x, op, noside);
2560           goto default_case_after_eval;
2561         }
2562
2563       return x;
2564
2565     case UNOP_MEMVAL:
2566       (*pos) += 3;
2567       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2568                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2569
2570     case OP_VAR_VALUE:
2571       var = exp->elts[pc + 2].symbol;
2572
2573       /* C++: The "address" of a reference should yield the address
2574        * of the object pointed to. Let value_addr() deal with it. */
2575       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2576         goto default_case;
2577
2578       (*pos) += 4;
2579       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2580         {
2581           struct type *type =
2582           lookup_pointer_type (SYMBOL_TYPE (var));
2583           enum address_class sym_class = SYMBOL_CLASS (var);
2584
2585           if (sym_class == LOC_CONST
2586               || sym_class == LOC_CONST_BYTES
2587               || sym_class == LOC_REGISTER)
2588             error (_("Attempt to take address of register or constant."));
2589
2590           return
2591             value_zero (type, not_lval);
2592         }
2593       else
2594         return address_of_variable (var, exp->elts[pc + 1].block);
2595
2596     case OP_SCOPE:
2597       tem = longest_to_int (exp->elts[pc + 2].longconst);
2598       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2599       x = value_aggregate_elt (exp->elts[pc + 1].type,
2600                                &exp->elts[pc + 3].string,
2601                                1, noside);
2602       if (x == NULL)
2603         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2604       return x;
2605
2606     default:
2607     default_case:
2608       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2609     default_case_after_eval:
2610       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2611         {
2612           struct type *type = check_typedef (value_type (x));
2613
2614           if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2615             return value_zero (lookup_pointer_type (value_type (x)),
2616                                not_lval);
2617           else if (TYPE_CODE (type) == TYPE_CODE_REF)
2618             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2619                                not_lval);
2620           else
2621             error (_("Attempt to take address of value not located in memory."));
2622         }
2623       return value_addr (x);
2624     }
2625 }
2626
2627 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2628    When used in contexts where arrays will be coerced anyway, this is
2629    equivalent to `evaluate_subexp' but much faster because it avoids
2630    actually fetching array contents (perhaps obsolete now that we have
2631    value_lazy()).
2632
2633    Note that we currently only do the coercion for C expressions, where
2634    arrays are zero based and the coercion is correct.  For other languages,
2635    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2636    to decide if coercion is appropriate.
2637
2638  */
2639
2640 struct value *
2641 evaluate_subexp_with_coercion (struct expression *exp,
2642                                int *pos, enum noside noside)
2643 {
2644   enum exp_opcode op;
2645   int pc;
2646   struct value *val;
2647   struct symbol *var;
2648   struct type *type;
2649
2650   pc = (*pos);
2651   op = exp->elts[pc].opcode;
2652
2653   switch (op)
2654     {
2655     case OP_VAR_VALUE:
2656       var = exp->elts[pc + 2].symbol;
2657       type = check_typedef (SYMBOL_TYPE (var));
2658       if (TYPE_CODE (type) == TYPE_CODE_ARRAY
2659           && CAST_IS_CONVERSION)
2660         {
2661           (*pos) += 4;
2662           val = address_of_variable (var, exp->elts[pc + 1].block);
2663           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2664                              val);
2665         }
2666       /* FALLTHROUGH */
2667
2668     default:
2669       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2670     }
2671 }
2672
2673 /* Evaluate a subexpression of EXP, at index *POS,
2674    and return a value for the size of that subexpression.
2675    Advance *POS over the subexpression.  */
2676
2677 static struct value *
2678 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2679 {
2680   /* FIXME: This should be size_t.  */
2681   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
2682   enum exp_opcode op;
2683   int pc;
2684   struct type *type;
2685   struct value *val;
2686
2687   pc = (*pos);
2688   op = exp->elts[pc].opcode;
2689
2690   switch (op)
2691     {
2692       /* This case is handled specially
2693          so that we avoid creating a value for the result type.
2694          If the result type is very big, it's desirable not to
2695          create a value unnecessarily.  */
2696     case UNOP_IND:
2697       (*pos)++;
2698       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2699       type = check_typedef (value_type (val));
2700       if (TYPE_CODE (type) != TYPE_CODE_PTR
2701           && TYPE_CODE (type) != TYPE_CODE_REF
2702           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2703         error (_("Attempt to take contents of a non-pointer value."));
2704       type = check_typedef (TYPE_TARGET_TYPE (type));
2705       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2706
2707     case UNOP_MEMVAL:
2708       (*pos) += 3;
2709       type = check_typedef (exp->elts[pc + 1].type);
2710       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2711
2712     case OP_VAR_VALUE:
2713       (*pos) += 4;
2714       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2715       return
2716         value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2717
2718     default:
2719       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2720       return value_from_longest (size_type,
2721                                  (LONGEST) TYPE_LENGTH (value_type (val)));
2722     }
2723 }
2724
2725 /* Parse a type expression in the string [P..P+LENGTH). */
2726
2727 struct type *
2728 parse_and_eval_type (char *p, int length)
2729 {
2730   char *tmp = (char *) alloca (length + 4);
2731   struct expression *expr;
2732   tmp[0] = '(';
2733   memcpy (tmp + 1, p, length);
2734   tmp[length + 1] = ')';
2735   tmp[length + 2] = '0';
2736   tmp[length + 3] = '\0';
2737   expr = parse_expression (tmp);
2738   if (expr->elts[0].opcode != UNOP_CAST)
2739     error (_("Internal error in eval_type."));
2740   return expr->elts[1].type;
2741 }
2742
2743 int
2744 calc_f77_array_dims (struct type *array_type)
2745 {
2746   int ndimen = 1;
2747   struct type *tmp_type;
2748
2749   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2750     error (_("Can't get dimensions for a non-array type"));
2751
2752   tmp_type = array_type;
2753
2754   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2755     {
2756       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2757         ++ndimen;
2758     }
2759   return ndimen;
2760 }