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