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 struct value *
 443 evaluate_subexp_standard (struct type *expect_type,
 444                           struct expression *exp, int *pos,
 445                           enum noside noside)
 446 {
 447   enum exp_opcode op;
 448   int tem, tem2, tem3;
 449   int pc, pc2 = 0, oldpos;
 450   struct value *arg1 = NULL;
 451   struct value *arg2 = NULL;
 452   struct value *arg3;
 453   struct type *type;
 454   int nargs;
 455   struct value **argvec;
 456   int upper, lower, retcode;
 457   int code;
 458   int ix;
 459   long mem_offset;
 460   struct type **arg_types;
 461   int save_pos1;
 462
 463   pc = (*pos)++;
 464   op = exp->elts[pc].opcode;
 465
 466   switch (op)
 467     {
 468     case OP_SCOPE:
 469       tem = longest_to_int (exp->elts[pc + 2].longconst);
 470       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
 471       if (noside == EVAL_SKIP)
 472         goto nosideret;
 473       arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
 474                                   &exp->elts[pc + 3].string,
 475                                   0, noside);
 476       if (arg1 == NULL)
 477         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
 478       return arg1;
 479
 480     case OP_LONG:
 481       (*pos) += 3;
 482       return value_from_longest (exp->elts[pc + 1].type,
 483                                  exp->elts[pc + 2].longconst);
 484
 485     case OP_DOUBLE:
 486       (*pos) += 3;
 487       return value_from_double (exp->elts[pc + 1].type,
 488                                 exp->elts[pc + 2].doubleconst);
 489
 490     case OP_DECFLOAT:
 491       (*pos) += 3;
 492       return value_from_decfloat (exp->elts[pc + 1].type,
 493                                   exp->elts[pc + 2].decfloatconst);
 494
 495     case OP_VAR_VALUE:
 496       (*pos) += 3;
 497       if (noside == EVAL_SKIP)
 498         goto nosideret;
 499
 500       /* JYG: We used to just return value_zero of the symbol type
 501          if we're asked to avoid side effects.  Otherwise we return
 502          value_of_variable (...).  However I'm not sure if
 503          value_of_variable () has any side effect.
 504          We need a full value object returned here for whatis_exp ()
 505          to call evaluate_type () and then pass the full value to
 506          value_rtti_target_type () if we are dealing with a pointer
 507          or reference to a base class and print object is on. */
 508
 509       {
 510         volatile struct gdb_exception except;
 511         struct value *ret = NULL;
 512
 513         TRY_CATCH (except, RETURN_MASK_ERROR)
 514           {
 515             ret = value_of_variable (exp->elts[pc + 2].symbol,
 516                                      exp->elts[pc + 1].block);
 517           }
 518
 519         if (except.reason < 0)
 520           {
 521             if (noside == EVAL_AVOID_SIDE_EFFECTS)
 522               ret = value_zero (SYMBOL_TYPE (exp->elts[pc + 2].symbol), not_lval);
 523             else
 524               throw_exception (except);
 525           }
 526
 527         return ret;
 528       }
 529
 530     case OP_LAST:
 531       (*pos) += 2;
 532       return
 533         access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
 534
 535     case OP_REGISTER:
 536       {
 537         const char *name = &exp->elts[pc + 2].string;
 538         int regno;
 539         struct value *val;
 540
 541         (*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
 542         regno = user_reg_map_name_to_regnum (current_gdbarch,
 543                                              name, strlen (name));
 544         if (regno == -1)
 545           error (_("Register $%s not available."), name);
 546
 547         /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
 548            a value with the appropriate register type.  Unfortunately,
 549            we don't have easy access to the type of user registers.
 550            So for these registers, we fetch the register value regardless
 551            of the evaluation mode.  */
 552         if (noside == EVAL_AVOID_SIDE_EFFECTS
 553             && regno < gdbarch_num_regs (current_gdbarch)
 554                + gdbarch_num_pseudo_regs (current_gdbarch))
 555           val = value_zero (register_type (current_gdbarch, regno), not_lval);
 556         else
 557           val = value_of_register (regno, get_selected_frame (NULL));
 558         if (val == NULL)
 559           error (_("Value of register %s not available."), name);
 560         else
 561           return val;
 562       }
 563     case OP_BOOL:
 564       (*pos) += 2;
 565       type = language_bool_type (exp->language_defn, exp->gdbarch);
 566       return value_from_longest (type, exp->elts[pc + 1].longconst);
 567
 568     case OP_INTERNALVAR:
 569       (*pos) += 2;
 570       return value_of_internalvar (exp->elts[pc + 1].internalvar);
 571
 572     case OP_STRING:
 573       tem = longest_to_int (exp->elts[pc + 1].longconst);
 574       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 575       if (noside == EVAL_SKIP)
 576         goto nosideret;
 577       return value_string (&exp->elts[pc + 2].string, tem);
 578
 579     case OP_OBJC_NSSTRING:              /* Objective C Foundation Class NSString constant.  */
 580       tem = longest_to_int (exp->elts[pc + 1].longconst);
 581       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 582       if (noside == EVAL_SKIP)
 583         {
 584           goto nosideret;
 585         }
 586       return (struct value *) value_nsstring (&exp->elts[pc + 2].string, tem + 1);
 587
 588     case OP_BITSTRING:
 589       tem = longest_to_int (exp->elts[pc + 1].longconst);
 590       (*pos)
 591         += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
 592       if (noside == EVAL_SKIP)
 593         goto nosideret;
 594       return value_bitstring (&exp->elts[pc + 2].string, tem);
 595       break;
 596
 597     case OP_ARRAY:
 598       (*pos) += 3;
 599       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 600       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 601       nargs = tem3 - tem2 + 1;
 602       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 603
 604       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 605           && TYPE_CODE (type) == TYPE_CODE_STRUCT)
 606         {
 607           struct value *rec = allocate_value (expect_type);
 608           memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
 609           return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
 610         }
 611
 612       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 613           && TYPE_CODE (type) == TYPE_CODE_ARRAY)
 614         {
 615           struct type *range_type = TYPE_FIELD_TYPE (type, 0);
 616           struct type *element_type = TYPE_TARGET_TYPE (type);
 617           struct value *array = allocate_value (expect_type);
 618           int element_size = TYPE_LENGTH (check_typedef (element_type));
 619           LONGEST low_bound, high_bound, index;
 620           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 621             {
 622               low_bound = 0;
 623               high_bound = (TYPE_LENGTH (type) / element_size) - 1;
 624             }
 625           index = low_bound;
 626           memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
 627           for (tem = nargs; --nargs >= 0;)
 628             {
 629               struct value *element;
 630               int index_pc = 0;
 631               if (exp->elts[*pos].opcode == BINOP_RANGE)
 632                 {
 633                   index_pc = ++(*pos);
 634                   evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 635                 }
 636               element = evaluate_subexp (element_type, exp, pos, noside);
 637               if (value_type (element) != element_type)
 638                 element = value_cast (element_type, element);
 639               if (index_pc)
 640                 {
 641                   int continue_pc = *pos;
 642                   *pos = index_pc;
 643                   index = init_array_element (array, element, exp, pos, noside,
 644                                               low_bound, high_bound);
 645                   *pos = continue_pc;
 646                 }
 647               else
 648                 {
 649                   if (index > high_bound)
 650                     /* to avoid memory corruption */
 651                     error (_("Too many array elements"));
 652                   memcpy (value_contents_raw (array)
 653                           + (index - low_bound) * element_size,
 654                           value_contents (element),
 655                           element_size);
 656                 }
 657               index++;
 658             }
 659           return array;
 660         }
 661
 662       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 663           && TYPE_CODE (type) == TYPE_CODE_SET)
 664         {
 665           struct value *set = allocate_value (expect_type);
 666           gdb_byte *valaddr = value_contents_raw (set);
 667           struct type *element_type = TYPE_INDEX_TYPE (type);
 668           struct type *check_type = element_type;
 669           LONGEST low_bound, high_bound;
 670
 671           /* get targettype of elementtype */
 672           while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
 673                  TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
 674             check_type = TYPE_TARGET_TYPE (check_type);
 675
 676           if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
 677             error (_("(power)set type with unknown size"));
 678           memset (valaddr, '\0', TYPE_LENGTH (type));
 679           for (tem = 0; tem < nargs; tem++)
 680             {
 681               LONGEST range_low, range_high;
 682               struct type *range_low_type, *range_high_type;
 683               struct value *elem_val;
 684               if (exp->elts[*pos].opcode == BINOP_RANGE)
 685                 {
 686                   (*pos)++;
 687                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 688                   range_low_type = value_type (elem_val);
 689                   range_low = value_as_long (elem_val);
 690                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 691                   range_high_type = value_type (elem_val);
 692                   range_high = value_as_long (elem_val);
 693                 }
 694               else
 695                 {
 696                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 697                   range_low_type = range_high_type = value_type (elem_val);
 698                   range_low = range_high = value_as_long (elem_val);
 699                 }
 700               /* check types of elements to avoid mixture of elements from
 701                  different types. Also check if type of element is "compatible"
 702                  with element type of powerset */
 703               if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
 704                 range_low_type = TYPE_TARGET_TYPE (range_low_type);
 705               if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
 706                 range_high_type = TYPE_TARGET_TYPE (range_high_type);
 707               if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
 708                   (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
 709                    (range_low_type != range_high_type)))
 710                 /* different element modes */
 711                 error (_("POWERSET tuple elements of different mode"));
 712               if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
 713                   (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
 714                    range_low_type != check_type))
 715                 error (_("incompatible POWERSET tuple elements"));
 716               if (range_low > range_high)
 717                 {
 718                   warning (_("empty POWERSET tuple range"));
 719                   continue;
 720                 }
 721               if (range_low < low_bound || range_high > high_bound)
 722                 error (_("POWERSET tuple element out of range"));
 723               range_low -= low_bound;
 724               range_high -= low_bound;
 725               for (; range_low <= range_high; range_low++)
 726                 {
 727                   int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
 728                   if (gdbarch_bits_big_endian (current_gdbarch))
 729                     bit_index = TARGET_CHAR_BIT - 1 - bit_index;
 730                   valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
 731                     |= 1 << bit_index;
 732                 }
 733             }
 734           return set;
 735         }
 736
 737       argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
 738       for (tem = 0; tem < nargs; tem++)
 739         {
 740           /* Ensure that array expressions are coerced into pointer objects. */
 741           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 742         }
 743       if (noside == EVAL_SKIP)
 744         goto nosideret;
 745       return value_array (tem2, tem3, argvec);
 746
 747     case TERNOP_SLICE:
 748       {
 749         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 750         int lowbound
 751         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 752         int upper
 753         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 754         if (noside == EVAL_SKIP)
 755           goto nosideret;
 756         return value_slice (array, lowbound, upper - lowbound + 1);
 757       }
 758
 759     case TERNOP_SLICE_COUNT:
 760       {
 761         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 762         int lowbound
 763         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 764         int length
 765         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 766         return value_slice (array, lowbound, length);
 767       }
 768
 769     case TERNOP_COND:
 770       /* Skip third and second args to evaluate the first one.  */
 771       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 772       if (value_logical_not (arg1))
 773         {
 774           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 775           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 776         }
 777       else
 778         {
 779           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 780           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 781           return arg2;
 782         }
 783
 784     case OP_OBJC_SELECTOR:
 785       {                         /* Objective C @selector operator.  */
 786         char *sel = &exp->elts[pc + 2].string;
 787         int len = longest_to_int (exp->elts[pc + 1].longconst);
 788
 789         (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
 790         if (noside == EVAL_SKIP)
 791           goto nosideret;
 792
 793         if (sel[len] != 0)
 794           sel[len] = 0;         /* Make sure it's terminated.  */
 795         return value_from_longest (lookup_pointer_type (builtin_type_void),
 796                                    lookup_child_selector (sel));
 797       }
 798
 799     case OP_OBJC_MSGCALL:
 800       {                         /* Objective C message (method) call.  */
 801
 802         static CORE_ADDR responds_selector = 0;
 803         static CORE_ADDR method_selector = 0;
 804
 805         CORE_ADDR selector = 0;
 806
 807         int struct_return = 0;
 808         int sub_no_side = 0;
 809
 810         static struct value *msg_send = NULL;
 811         static struct value *msg_send_stret = NULL;
 812         static int gnu_runtime = 0;
 813
 814         struct value *target = NULL;
 815         struct value *method = NULL;
 816         struct value *called_method = NULL;
 817
 818         struct type *selector_type = NULL;
 819
 820         struct value *ret = NULL;
 821         CORE_ADDR addr = 0;
 822
 823         selector = exp->elts[pc + 1].longconst;
 824         nargs = exp->elts[pc + 2].longconst;
 825         argvec = (struct value **) alloca (sizeof (struct value *)
 826                                            * (nargs + 5));
 827
 828         (*pos) += 3;
 829
 830         selector_type = lookup_pointer_type (builtin_type_void);
 831         if (noside == EVAL_AVOID_SIDE_EFFECTS)
 832           sub_no_side = EVAL_NORMAL;
 833         else
 834           sub_no_side = noside;
 835
 836         target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
 837
 838         if (value_as_long (target) == 0)
 839           return value_from_longest (builtin_type_long, 0);
 840
 841         if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0))
 842           gnu_runtime = 1;
 843
 844         /* Find the method dispatch (Apple runtime) or method lookup
 845            (GNU runtime) function for Objective-C.  These will be used
 846            to lookup the symbol information for the method.  If we
 847            can't find any symbol information, then we'll use these to
 848            call the method, otherwise we can call the method
 849            directly. The msg_send_stret function is used in the special
 850            case of a method that returns a structure (Apple runtime
 851            only).  */
 852         if (gnu_runtime)
 853           {
 854             struct type *type;
 855             type = lookup_pointer_type (builtin_type_void);
 856             type = lookup_function_type (type);
 857             type = lookup_pointer_type (type);
 858             type = lookup_function_type (type);
 859             type = lookup_pointer_type (type);
 860
 861             msg_send = find_function_in_inferior ("objc_msg_lookup");
 862             msg_send_stret = find_function_in_inferior ("objc_msg_lookup");
 863
 864             msg_send = value_from_pointer (type, value_as_address (msg_send));
 865             msg_send_stret = value_from_pointer (type,
 866                                         value_as_address (msg_send_stret));
 867           }
 868         else
 869           {
 870             msg_send = find_function_in_inferior ("objc_msgSend");
 871             /* Special dispatcher for methods returning structs */
 872             msg_send_stret = find_function_in_inferior ("objc_msgSend_stret");
 873           }
 874
 875         /* Verify the target object responds to this method. The
 876            standard top-level 'Object' class uses a different name for
 877            the verification method than the non-standard, but more
 878            often used, 'NSObject' class. Make sure we check for both. */
 879
 880         responds_selector = lookup_child_selector ("respondsToSelector:");
 881         if (responds_selector == 0)
 882           responds_selector = lookup_child_selector ("respondsTo:");
 883
 884         if (responds_selector == 0)
 885           error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
 886
 887         method_selector = lookup_child_selector ("methodForSelector:");
 888         if (method_selector == 0)
 889           method_selector = lookup_child_selector ("methodFor:");
 890
 891         if (method_selector == 0)
 892           error (_("no 'methodFor:' or 'methodForSelector:' method"));
 893
 894         /* Call the verification method, to make sure that the target
 895          class implements the desired method. */
 896
 897         argvec[0] = msg_send;
 898         argvec[1] = target;
 899         argvec[2] = value_from_longest (builtin_type_long, responds_selector);
 900         argvec[3] = value_from_longest (builtin_type_long, selector);
 901         argvec[4] = 0;
 902
 903         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
 904         if (gnu_runtime)
 905           {
 906             /* Function objc_msg_lookup returns a pointer.  */
 907             argvec[0] = ret;
 908             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
 909           }
 910         if (value_as_long (ret) == 0)
 911           error (_("Target does not respond to this message selector."));
 912
 913         /* Call "methodForSelector:" method, to get the address of a
 914            function method that implements this selector for this
 915            class.  If we can find a symbol at that address, then we
 916            know the return type, parameter types etc.  (that's a good
 917            thing). */
 918
 919         argvec[0] = msg_send;
 920         argvec[1] = target;
 921         argvec[2] = value_from_longest (builtin_type_long, method_selector);
 922         argvec[3] = value_from_longest (builtin_type_long, selector);
 923         argvec[4] = 0;
 924
 925         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
 926         if (gnu_runtime)
 927           {
 928             argvec[0] = ret;
 929             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
 930           }
 931
 932         /* ret should now be the selector.  */
 933
 934         addr = value_as_long (ret);
 935         if (addr)
 936           {
 937             struct symbol *sym = NULL;
 938             /* Is it a high_level symbol?  */
 939
 940             sym = find_pc_function (addr);
 941             if (sym != NULL)
 942               method = value_of_variable (sym, 0);
 943           }
 944
 945         /* If we found a method with symbol information, check to see
 946            if it returns a struct.  Otherwise assume it doesn't.  */
 947
 948         if (method)
 949           {
 950             struct block *b;
 951             CORE_ADDR funaddr;
 952             struct type *val_type;
 953
 954             funaddr = find_function_addr (method, &val_type);
 955
 956             b = block_for_pc (funaddr);
 957
 958             CHECK_TYPEDEF (val_type);
 959
 960             if ((val_type == NULL)
 961                 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
 962               {
 963                 if (expect_type != NULL)
 964                   val_type = expect_type;
 965               }
 966
 967             struct_return = using_struct_return (value_type (method), val_type);
 968           }
 969         else if (expect_type != NULL)
 970           {
 971             struct_return = using_struct_return (NULL,
 972                                                  check_typedef (expect_type));
 973           }
 974
 975         /* Found a function symbol.  Now we will substitute its
 976            value in place of the message dispatcher (obj_msgSend),
 977            so that we call the method directly instead of thru
 978            the dispatcher.  The main reason for doing this is that
 979            we can now evaluate the return value and parameter values
 980            according to their known data types, in case we need to
 981            do things like promotion, dereferencing, special handling
 982            of structs and doubles, etc.
 983
 984            We want to use the type signature of 'method', but still
 985            jump to objc_msgSend() or objc_msgSend_stret() to better
 986            mimic the behavior of the runtime.  */
 987
 988         if (method)
 989           {
 990             if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
 991               error (_("method address has symbol information with non-function type; skipping"));
 992             if (struct_return)
 993               VALUE_ADDRESS (method) = value_as_address (msg_send_stret);
 994             else
 995               VALUE_ADDRESS (method) = value_as_address (msg_send);
 996             called_method = method;
 997           }
 998         else
 999           {
1000             if (struct_return)
1001               called_method = msg_send_stret;
1002             else
1003               called_method = msg_send;
1004           }
1005
1006         if (noside == EVAL_SKIP)
1007           goto nosideret;
1008
1009         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1010           {
1011             /* If the return type doesn't look like a function type,
1012                call an error.  This can happen if somebody tries to
1013                turn a variable into a function call. This is here
1014                because people often want to call, eg, strcmp, which
1015                gdb doesn't know is a function.  If gdb isn't asked for
1016                it's opinion (ie. through "whatis"), it won't offer
1017                it. */
1018
1019             struct type *type = value_type (called_method);
1020             if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1021               type = TYPE_TARGET_TYPE (type);
1022             type = TYPE_TARGET_TYPE (type);
1023
1024             if (type)
1025             {
1026               if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1027                 return allocate_value (expect_type);
1028               else
1029                 return allocate_value (type);
1030             }
1031             else
1032               error (_("Expression of type other than \"method returning ...\" used as a method"));
1033           }
1034
1035         /* Now depending on whether we found a symbol for the method,
1036            we will either call the runtime dispatcher or the method
1037            directly.  */
1038
1039         argvec[0] = called_method;
1040         argvec[1] = target;
1041         argvec[2] = value_from_longest (builtin_type_long, selector);
1042         /* User-supplied arguments.  */
1043         for (tem = 0; tem < nargs; tem++)
1044           argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1045         argvec[tem + 3] = 0;
1046
1047         if (gnu_runtime && (method != NULL))
1048           {
1049             /* Function objc_msg_lookup returns a pointer.  */
1050             deprecated_set_value_type (argvec[0],
1051                                        lookup_function_type (lookup_pointer_type (value_type (argvec[0]))));
1052             argvec[0] = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1053           }
1054
1055         ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1056         return ret;
1057       }
1058       break;
1059
1060     case OP_FUNCALL:
1061       (*pos) += 2;
1062       op = exp->elts[*pos].opcode;
1063       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1064       /* Allocate arg vector, including space for the function to be
1065          called in argvec[0] and a terminating NULL */
1066       argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
1067       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1068         {
1069           nargs++;
1070           /* First, evaluate the structure into arg2 */
1071           pc2 = (*pos)++;
1072
1073           if (noside == EVAL_SKIP)
1074             goto nosideret;
1075
1076           if (op == STRUCTOP_MEMBER)
1077             {
1078               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1079             }
1080           else
1081             {
1082               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1083             }
1084
1085           /* If the function is a virtual function, then the
1086              aggregate value (providing the structure) plays
1087              its part by providing the vtable.  Otherwise,
1088              it is just along for the ride: call the function
1089              directly.  */
1090
1091           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1092
1093           if (TYPE_CODE (check_typedef (value_type (arg1)))
1094               != TYPE_CODE_METHODPTR)
1095             error (_("Non-pointer-to-member value used in pointer-to-member "
1096                      "construct"));
1097
1098           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1099             {
1100               struct type *method_type = check_typedef (value_type (arg1));
1101               arg1 = value_zero (method_type, not_lval);
1102             }
1103           else
1104             arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1105
1106           /* Now, say which argument to start evaluating from */
1107           tem = 2;
1108         }
1109       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1110         {
1111           /* Hair for method invocations */
1112           int tem2;
1113
1114           nargs++;
1115           /* First, evaluate the structure into arg2 */
1116           pc2 = (*pos)++;
1117           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1118           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1119           if (noside == EVAL_SKIP)
1120             goto nosideret;
1121
1122           if (op == STRUCTOP_STRUCT)
1123             {
1124               /* If v is a variable in a register, and the user types
1125                  v.method (), this will produce an error, because v has
1126                  no address.
1127
1128                  A possible way around this would be to allocate a
1129                  copy of the variable on the stack, copy in the
1130                  contents, call the function, and copy out the
1131                  contents.  I.e. convert this from call by reference
1132                  to call by copy-return (or whatever it's called).
1133                  However, this does not work because it is not the
1134                  same: the method being called could stash a copy of
1135                  the address, and then future uses through that address
1136                  (after the method returns) would be expected to
1137                  use the variable itself, not some copy of it.  */
1138               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1139             }
1140           else
1141             {
1142               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1143             }
1144           /* Now, say which argument to start evaluating from */
1145           tem = 2;
1146         }
1147       else
1148         {
1149           /* Non-method function call */
1150           save_pos1 = *pos;
1151           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1152           tem = 1;
1153           type = value_type (argvec[0]);
1154           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1155             type = TYPE_TARGET_TYPE (type);
1156           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1157             {
1158               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1159                 {
1160                   /* pai: FIXME This seems to be coercing arguments before
1161                    * overload resolution has been done! */
1162                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
1163                                                  exp, pos, noside);
1164                 }
1165             }
1166         }
1167
1168       /* Evaluate arguments */
1169       for (; tem <= nargs; tem++)
1170         {
1171           /* Ensure that array expressions are coerced into pointer objects. */
1172           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1173         }
1174
1175       /* signal end of arglist */
1176       argvec[tem] = 0;
1177
1178       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1179         {
1180           int static_memfuncp;
1181           char tstr[256];
1182
1183           /* Method invocation : stuff "this" as first parameter */
1184           argvec[1] = arg2;
1185           /* Name of method from expression */
1186           strcpy (tstr, &exp->elts[pc2 + 2].string);
1187
1188           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1189             {
1190               /* Language is C++, do some overload resolution before evaluation */
1191               struct value *valp = NULL;
1192
1193               /* Prepare list of argument types for overload resolution */
1194               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1195               for (ix = 1; ix <= nargs; ix++)
1196                 arg_types[ix - 1] = value_type (argvec[ix]);
1197
1198               (void) find_overload_match (arg_types, nargs, tstr,
1199                                      1 /* method */ , 0 /* strict match */ ,
1200                                           &arg2 /* the object */ , NULL,
1201                                           &valp, NULL, &static_memfuncp);
1202
1203
1204               argvec[1] = arg2; /* the ``this'' pointer */
1205               argvec[0] = valp; /* use the method found after overload resolution */
1206             }
1207           else
1208             /* Non-C++ case -- or no overload resolution */
1209             {
1210               struct value *temp = arg2;
1211               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1212                                             &static_memfuncp,
1213                                             op == STRUCTOP_STRUCT
1214                                        ? "structure" : "structure pointer");
1215               /* value_struct_elt updates temp with the correct value
1216                  of the ``this'' pointer if necessary, so modify argvec[1] to
1217                  reflect any ``this'' changes.  */
1218               arg2 = value_from_longest (lookup_pointer_type(value_type (temp)),
1219                                          VALUE_ADDRESS (temp) + value_offset (temp)
1220                                          + value_embedded_offset (temp));
1221               argvec[1] = arg2; /* the ``this'' pointer */
1222             }
1223
1224           if (static_memfuncp)
1225             {
1226               argvec[1] = argvec[0];
1227               nargs--;
1228               argvec++;
1229             }
1230         }
1231       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1232         {
1233           argvec[1] = arg2;
1234           argvec[0] = arg1;
1235         }
1236       else if (op == OP_VAR_VALUE)
1237         {
1238           /* Non-member function being called */
1239           /* fn: This can only be done for C++ functions.  A C-style function
1240              in a C++ program, for instance, does not have the fields that
1241              are expected here */
1242
1243           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1244             {
1245               /* Language is C++, do some overload resolution before evaluation */
1246               struct symbol *symp;
1247
1248               /* Prepare list of argument types for overload resolution */
1249               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1250               for (ix = 1; ix <= nargs; ix++)
1251                 arg_types[ix - 1] = value_type (argvec[ix]);
1252
1253               (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
1254                                  0 /* not method */ , 0 /* strict match */ ,
1255                       NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
1256                                           NULL, &symp, NULL);
1257
1258               /* Now fix the expression being evaluated */
1259               exp->elts[save_pos1+2].symbol = symp;
1260               argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1261             }
1262           else
1263             {
1264               /* Not C++, or no overload resolution allowed */
1265               /* nothing to be done; argvec already correctly set up */
1266             }
1267         }
1268       else
1269         {
1270           /* It is probably a C-style function */
1271           /* nothing to be done; argvec already correctly set up */
1272         }
1273
1274     do_call_it:
1275
1276       if (noside == EVAL_SKIP)
1277         goto nosideret;
1278       if (argvec[0] == NULL)
1279         error (_("Cannot evaluate function -- may be inlined"));
1280       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1281         {
1282           /* If the return type doesn't look like a function type, call an
1283              error.  This can happen if somebody tries to turn a variable into
1284              a function call. This is here because people often want to
1285              call, eg, strcmp, which gdb doesn't know is a function.  If
1286              gdb isn't asked for it's opinion (ie. through "whatis"),
1287              it won't offer it. */
1288
1289           struct type *ftype =
1290           TYPE_TARGET_TYPE (value_type (argvec[0]));
1291
1292           if (ftype)
1293             return allocate_value (TYPE_TARGET_TYPE (value_type (argvec[0])));
1294           else
1295             error (_("Expression of type other than \"Function returning ...\" used as function"));
1296         }
1297       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1298       /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
1299
1300     case OP_F77_UNDETERMINED_ARGLIST:
1301
1302       /* Remember that in F77, functions, substring ops and
1303          array subscript operations cannot be disambiguated
1304          at parse time.  We have made all array subscript operations,
1305          substring operations as well as function calls  come here
1306          and we now have to discover what the heck this thing actually was.
1307          If it is a function, we process just as if we got an OP_FUNCALL. */
1308
1309       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1310       (*pos) += 2;
1311
1312       /* First determine the type code we are dealing with.  */
1313       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1314       type = check_typedef (value_type (arg1));
1315       code = TYPE_CODE (type);
1316
1317       if (code == TYPE_CODE_PTR)
1318         {
1319           /* Fortran always passes variable to subroutines as pointer.
1320              So we need to look into its target type to see if it is
1321              array, string or function.  If it is, we need to switch
1322              to the target value the original one points to.  */
1323           struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1324
1325           if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1326               || TYPE_CODE (target_type) == TYPE_CODE_STRING
1327               || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1328             {
1329               arg1 = value_ind (arg1);
1330               type = check_typedef (value_type (arg1));
1331               code = TYPE_CODE (type);
1332             }
1333         }
1334
1335       switch (code)
1336         {
1337         case TYPE_CODE_ARRAY:
1338           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1339             return value_f90_subarray (arg1, exp, pos, noside);
1340           else
1341             goto multi_f77_subscript;
1342
1343         case TYPE_CODE_STRING:
1344           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1345             return value_f90_subarray (arg1, exp, pos, noside);
1346           else
1347             {
1348               arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1349               return value_subscript (arg1, arg2);
1350             }
1351
1352         case TYPE_CODE_PTR:
1353         case TYPE_CODE_FUNC:
1354           /* It's a function call. */
1355           /* Allocate arg vector, including space for the function to be
1356              called in argvec[0] and a terminating NULL */
1357           argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
1358           argvec[0] = arg1;
1359           tem = 1;
1360           for (; tem <= nargs; tem++)
1361             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1362           argvec[tem] = 0;      /* signal end of arglist */
1363           goto do_call_it;
1364
1365         default:
1366           error (_("Cannot perform substring on this type"));
1367         }
1368
1369     case OP_COMPLEX:
1370       /* We have a complex number, There should be 2 floating
1371          point numbers that compose it */
1372       (*pos) += 2;
1373       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1374       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1375
1376       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1377
1378     case STRUCTOP_STRUCT:
1379       tem = longest_to_int (exp->elts[pc + 1].longconst);
1380       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1381       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1382       if (noside == EVAL_SKIP)
1383         goto nosideret;
1384       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1385         return value_zero (lookup_struct_elt_type (value_type (arg1),
1386                                                    &exp->elts[pc + 2].string,
1387                                                    0),
1388                            lval_memory);
1389       else
1390         {
1391           struct value *temp = arg1;
1392           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1393                                    NULL, "structure");
1394         }
1395
1396     case STRUCTOP_PTR:
1397       tem = longest_to_int (exp->elts[pc + 1].longconst);
1398       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1399       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1400       if (noside == EVAL_SKIP)
1401         goto nosideret;
1402
1403       /* JYG: if print object is on we need to replace the base type
1404          with rtti type in order to continue on with successful
1405          lookup of member / method only available in the rtti type. */
1406       {
1407         struct type *type = value_type (arg1);
1408         struct type *real_type;
1409         int full, top, using_enc;
1410
1411         if (objectprint && TYPE_TARGET_TYPE(type) &&
1412             (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1413           {
1414             real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1415             if (real_type)
1416               {
1417                 if (TYPE_CODE (type) == TYPE_CODE_PTR)
1418                   real_type = lookup_pointer_type (real_type);
1419                 else
1420                   real_type = lookup_reference_type (real_type);
1421
1422                 arg1 = value_cast (real_type, arg1);
1423               }
1424           }
1425       }
1426
1427       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1428         return value_zero (lookup_struct_elt_type (value_type (arg1),
1429                                                    &exp->elts[pc + 2].string,
1430                                                    0),
1431                            lval_memory);
1432       else
1433         {
1434           struct value *temp = arg1;
1435           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1436                                    NULL, "structure pointer");
1437         }
1438
1439     case STRUCTOP_MEMBER:
1440     case STRUCTOP_MPTR:
1441       if (op == STRUCTOP_MEMBER)
1442         arg1 = evaluate_subexp_for_address (exp, pos, noside);
1443       else
1444         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1445
1446       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1447
1448       if (noside == EVAL_SKIP)
1449         goto nosideret;
1450
1451       type = check_typedef (value_type (arg2));
1452       switch (TYPE_CODE (type))
1453         {
1454         case TYPE_CODE_METHODPTR:
1455           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1456             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
1457           else
1458             {
1459               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
1460               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
1461               return value_ind (arg2);
1462             }
1463
1464         case TYPE_CODE_MEMBERPTR:
1465           /* Now, convert these values to an address.  */
1466           arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1467                              arg1);
1468
1469           mem_offset = value_as_long (arg2);
1470
1471           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1472                                      value_as_long (arg1) + mem_offset);
1473           return value_ind (arg3);
1474
1475         default:
1476           error (_("non-pointer-to-member value used in pointer-to-member construct"));
1477         }
1478
1479     case BINOP_CONCAT:
1480       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1481       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1482       if (noside == EVAL_SKIP)
1483         goto nosideret;
1484       if (binop_user_defined_p (op, arg1, arg2))
1485         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1486       else
1487         return value_concat (arg1, arg2);
1488
1489     case BINOP_ASSIGN:
1490       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1491       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1492
1493       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1494         return arg1;
1495       if (binop_user_defined_p (op, arg1, arg2))
1496         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1497       else
1498         return value_assign (arg1, arg2);
1499
1500     case BINOP_ASSIGN_MODIFY:
1501       (*pos) += 2;
1502       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1503       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1504       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1505         return arg1;
1506       op = exp->elts[pc + 1].opcode;
1507       if (binop_user_defined_p (op, arg1, arg2))
1508         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1509       else if (op == BINOP_ADD)
1510         arg2 = value_add (arg1, arg2);
1511       else if (op == BINOP_SUB)
1512         arg2 = value_sub (arg1, arg2);
1513       else
1514         arg2 = value_binop (arg1, arg2, op);
1515       return value_assign (arg1, arg2);
1516
1517     case BINOP_ADD:
1518       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1519       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1520       if (noside == EVAL_SKIP)
1521         goto nosideret;
1522       if (binop_user_defined_p (op, arg1, arg2))
1523         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1524       else
1525         return value_add (arg1, arg2);
1526
1527     case BINOP_SUB:
1528       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1529       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1530       if (noside == EVAL_SKIP)
1531         goto nosideret;
1532       if (binop_user_defined_p (op, arg1, arg2))
1533         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1534       else
1535         return value_sub (arg1, arg2);
1536
1537     case BINOP_EXP:
1538     case BINOP_MUL:
1539     case BINOP_DIV:
1540     case BINOP_INTDIV:
1541     case BINOP_REM:
1542     case BINOP_MOD:
1543     case BINOP_LSH:
1544     case BINOP_RSH:
1545     case BINOP_BITWISE_AND:
1546     case BINOP_BITWISE_IOR:
1547     case BINOP_BITWISE_XOR:
1548       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1549       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1550       if (noside == EVAL_SKIP)
1551         goto nosideret;
1552       if (binop_user_defined_p (op, arg1, arg2))
1553         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1554       else
1555         {
1556           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
1557              fudge arg2 to avoid division-by-zero, the caller is
1558              (theoretically) only looking for the type of the result.  */
1559           if (noside == EVAL_AVOID_SIDE_EFFECTS
1560               /* ??? Do we really want to test for BINOP_MOD here?
1561                  The implementation of value_binop gives it a well-defined
1562                  value.  */
1563               && (op == BINOP_DIV
1564                   || op == BINOP_INTDIV
1565                   || op == BINOP_REM
1566                   || op == BINOP_MOD)
1567               && value_logical_not (arg2))
1568             {
1569               struct value *v_one, *retval;
1570
1571               v_one = value_one (value_type (arg2), not_lval);
1572               retval = value_binop (arg1, v_one, op);
1573               return retval;
1574             }
1575           else
1576             return value_binop (arg1, arg2, op);
1577         }
1578
1579     case BINOP_RANGE:
1580       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1581       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1582       if (noside == EVAL_SKIP)
1583         goto nosideret;
1584       error (_("':' operator used in invalid context"));
1585
1586     case BINOP_SUBSCRIPT:
1587       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1588       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1589       if (noside == EVAL_SKIP)
1590         goto nosideret;
1591       if (binop_user_defined_p (op, arg1, arg2))
1592         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1593       else
1594         {
1595           /* If the user attempts to subscript something that is not an
1596              array or pointer type (like a plain int variable for example),
1597              then report this as an error. */
1598
1599           arg1 = coerce_ref (arg1);
1600           type = check_typedef (value_type (arg1));
1601           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1602               && TYPE_CODE (type) != TYPE_CODE_PTR)
1603             {
1604               if (TYPE_NAME (type))
1605                 error (_("cannot subscript something of type `%s'"),
1606                        TYPE_NAME (type));
1607               else
1608                 error (_("cannot subscript requested type"));
1609             }
1610
1611           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1612             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1613           else
1614             return value_subscript (arg1, arg2);
1615         }
1616
1617     case BINOP_IN:
1618       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1619       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1620       if (noside == EVAL_SKIP)
1621         goto nosideret;
1622       type = language_bool_type (exp->language_defn, exp->gdbarch);
1623       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
1624
1625     case MULTI_SUBSCRIPT:
1626       (*pos) += 2;
1627       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1628       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1629       while (nargs-- > 0)
1630         {
1631           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1632           /* FIXME:  EVAL_SKIP handling may not be correct. */
1633           if (noside == EVAL_SKIP)
1634             {
1635               if (nargs > 0)
1636                 {
1637                   continue;
1638                 }
1639               else
1640                 {
1641                   goto nosideret;
1642                 }
1643             }
1644           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1645           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1646             {
1647               /* If the user attempts to subscript something that has no target
1648                  type (like a plain int variable for example), then report this
1649                  as an error. */
1650
1651               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
1652               if (type != NULL)
1653                 {
1654                   arg1 = value_zero (type, VALUE_LVAL (arg1));
1655                   noside = EVAL_SKIP;
1656                   continue;
1657                 }
1658               else
1659                 {
1660                   error (_("cannot subscript something of type `%s'"),
1661                          TYPE_NAME (value_type (arg1)));
1662                 }
1663             }
1664
1665           if (binop_user_defined_p (op, arg1, arg2))
1666             {
1667               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1668             }
1669           else
1670             {
1671               arg1 = coerce_ref (arg1);
1672               type = check_typedef (value_type (arg1));
1673
1674               switch (TYPE_CODE (type))
1675                 {
1676                 case TYPE_CODE_PTR:
1677                 case TYPE_CODE_ARRAY:
1678                 case TYPE_CODE_STRING:
1679                   arg1 = value_subscript (arg1, arg2);
1680                   break;
1681
1682                 case TYPE_CODE_BITSTRING:
1683                   type = language_bool_type (exp->language_defn, exp->gdbarch);
1684                   arg1 = value_bitstring_subscript (type, arg1, arg2);
1685                   break;
1686
1687                 default:
1688                   if (TYPE_NAME (type))
1689                     error (_("cannot subscript something of type `%s'"),
1690                            TYPE_NAME (type));
1691                   else
1692                     error (_("cannot subscript requested type"));
1693                 }
1694             }
1695         }
1696       return (arg1);
1697
1698     multi_f77_subscript:
1699       {
1700         int subscript_array[MAX_FORTRAN_DIMS];
1701         int array_size_array[MAX_FORTRAN_DIMS];
1702         int ndimensions = 1, i;
1703         struct type *tmp_type;
1704         int offset_item;        /* The array offset where the item lives */
1705
1706         if (nargs > MAX_FORTRAN_DIMS)
1707           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
1708
1709         tmp_type = check_typedef (value_type (arg1));
1710         ndimensions = calc_f77_array_dims (type);
1711
1712         if (nargs != ndimensions)
1713           error (_("Wrong number of subscripts"));
1714
1715         /* Now that we know we have a legal array subscript expression
1716            let us actually find out where this element exists in the array. */
1717
1718         offset_item = 0;
1719         /* Take array indices left to right */
1720         for (i = 0; i < nargs; i++)
1721           {
1722             /* Evaluate each subscript, It must be a legal integer in F77 */
1723             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1724
1725             /* Fill in the subscript and array size arrays */
1726
1727             subscript_array[i] = value_as_long (arg2);
1728           }
1729
1730         /* Internal type of array is arranged right to left */
1731         for (i = 0; i < nargs; i++)
1732           {
1733             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1734             if (retcode == BOUND_FETCH_ERROR)
1735               error (_("Cannot obtain dynamic upper bound"));
1736
1737             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1738             if (retcode == BOUND_FETCH_ERROR)
1739               error (_("Cannot obtain dynamic lower bound"));
1740
1741             array_size_array[nargs - i - 1] = upper - lower + 1;
1742
1743             /* Zero-normalize subscripts so that offsetting will work. */
1744
1745             subscript_array[nargs - i - 1] -= lower;
1746
1747             /* If we are at the bottom of a multidimensional
1748                array type then keep a ptr to the last ARRAY
1749                type around for use when calling value_subscript()
1750                below. This is done because we pretend to value_subscript
1751                that we actually have a one-dimensional array
1752                of base element type that we apply a simple
1753                offset to. */
1754
1755             if (i < nargs - 1)
1756               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1757           }
1758
1759         /* Now let us calculate the offset for this item */
1760
1761         offset_item = subscript_array[ndimensions - 1];
1762
1763         for (i = ndimensions - 1; i > 0; --i)
1764           offset_item =
1765             array_size_array[i - 1] * offset_item + subscript_array[i - 1];
1766
1767         /* Construct a value node with the value of the offset */
1768
1769         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1770
1771         /* Let us now play a dirty trick: we will take arg1
1772            which is a value node pointing to the topmost level
1773            of the multidimensional array-set and pretend
1774            that it is actually a array of the final element
1775            type, this will ensure that value_subscript()
1776            returns the correct type value */
1777
1778         deprecated_set_value_type (arg1, tmp_type);
1779         return value_subscripted_rvalue (arg1, arg2, 0);
1780       }
1781
1782     case BINOP_LOGICAL_AND:
1783       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1784       if (noside == EVAL_SKIP)
1785         {
1786           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1787           goto nosideret;
1788         }
1789
1790       oldpos = *pos;
1791       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1792       *pos = oldpos;
1793
1794       if (binop_user_defined_p (op, arg1, arg2))
1795         {
1796           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1797           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1798         }
1799       else
1800         {
1801           tem = value_logical_not (arg1);
1802           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1803                                   (tem ? EVAL_SKIP : noside));
1804           type = language_bool_type (exp->language_defn, exp->gdbarch);
1805           return value_from_longest (type,
1806                              (LONGEST) (!tem && !value_logical_not (arg2)));
1807         }
1808
1809     case BINOP_LOGICAL_OR:
1810       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1811       if (noside == EVAL_SKIP)
1812         {
1813           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1814           goto nosideret;
1815         }
1816
1817       oldpos = *pos;
1818       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1819       *pos = oldpos;
1820
1821       if (binop_user_defined_p (op, arg1, arg2))
1822         {
1823           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1824           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1825         }
1826       else
1827         {
1828           tem = value_logical_not (arg1);
1829           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1830                                   (!tem ? EVAL_SKIP : noside));
1831           type = language_bool_type (exp->language_defn, exp->gdbarch);
1832           return value_from_longest (type,
1833                              (LONGEST) (!tem || !value_logical_not (arg2)));
1834         }
1835
1836     case BINOP_EQUAL:
1837       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1838       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1839       if (noside == EVAL_SKIP)
1840         goto nosideret;
1841       if (binop_user_defined_p (op, arg1, arg2))
1842         {
1843           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1844         }
1845       else
1846         {
1847           tem = value_equal (arg1, arg2);
1848           type = language_bool_type (exp->language_defn, exp->gdbarch);
1849           return value_from_longest (type, (LONGEST) tem);
1850         }
1851
1852     case BINOP_NOTEQUAL:
1853       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1854       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1855       if (noside == EVAL_SKIP)
1856         goto nosideret;
1857       if (binop_user_defined_p (op, arg1, arg2))
1858         {
1859           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1860         }
1861       else
1862         {
1863           tem = value_equal (arg1, arg2);
1864           type = language_bool_type (exp->language_defn, exp->gdbarch);
1865           return value_from_longest (type, (LONGEST) ! tem);
1866         }
1867
1868     case BINOP_LESS:
1869       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1870       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1871       if (noside == EVAL_SKIP)
1872         goto nosideret;
1873       if (binop_user_defined_p (op, arg1, arg2))
1874         {
1875           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1876         }
1877       else
1878         {
1879           tem = value_less (arg1, arg2);
1880           type = language_bool_type (exp->language_defn, exp->gdbarch);
1881           return value_from_longest (type, (LONGEST) tem);
1882         }
1883
1884     case BINOP_GTR:
1885       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1886       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1887       if (noside == EVAL_SKIP)
1888         goto nosideret;
1889       if (binop_user_defined_p (op, arg1, arg2))
1890         {
1891           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1892         }
1893       else
1894         {
1895           tem = value_less (arg2, arg1);
1896           type = language_bool_type (exp->language_defn, exp->gdbarch);
1897           return value_from_longest (type, (LONGEST) tem);
1898         }
1899
1900     case BINOP_GEQ:
1901       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1902       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1903       if (noside == EVAL_SKIP)
1904         goto nosideret;
1905       if (binop_user_defined_p (op, arg1, arg2))
1906         {
1907           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1908         }
1909       else
1910         {
1911           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1912           type = language_bool_type (exp->language_defn, exp->gdbarch);
1913           return value_from_longest (type, (LONGEST) tem);
1914         }
1915
1916     case BINOP_LEQ:
1917       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1918       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1919       if (noside == EVAL_SKIP)
1920         goto nosideret;
1921       if (binop_user_defined_p (op, arg1, arg2))
1922         {
1923           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1924         }
1925       else
1926         {
1927           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1928           type = language_bool_type (exp->language_defn, exp->gdbarch);
1929           return value_from_longest (type, (LONGEST) tem);
1930         }
1931
1932     case BINOP_REPEAT:
1933       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1934       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1935       if (noside == EVAL_SKIP)
1936         goto nosideret;
1937       type = check_typedef (value_type (arg2));
1938       if (TYPE_CODE (type) != TYPE_CODE_INT)
1939         error (_("Non-integral right operand for \"@\" operator."));
1940       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1941         {
1942           return allocate_repeat_value (value_type (arg1),
1943                                      longest_to_int (value_as_long (arg2)));
1944         }
1945       else
1946         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1947
1948     case BINOP_COMMA:
1949       evaluate_subexp (NULL_TYPE, exp, pos, noside);
1950       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1951
1952     case UNOP_PLUS:
1953       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1954       if (noside == EVAL_SKIP)
1955         goto nosideret;
1956       if (unop_user_defined_p (op, arg1))
1957         return value_x_unop (arg1, op, noside);
1958       else
1959         return value_pos (arg1);
1960
1961     case UNOP_NEG:
1962       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1963       if (noside == EVAL_SKIP)
1964         goto nosideret;
1965       if (unop_user_defined_p (op, arg1))
1966         return value_x_unop (arg1, op, noside);
1967       else
1968         return value_neg (arg1);
1969
1970     case UNOP_COMPLEMENT:
1971       /* C++: check for and handle destructor names.  */
1972       op = exp->elts[*pos].opcode;
1973
1974       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1975       if (noside == EVAL_SKIP)
1976         goto nosideret;
1977       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1978         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1979       else
1980         return value_complement (arg1);
1981
1982     case UNOP_LOGICAL_NOT:
1983       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1984       if (noside == EVAL_SKIP)
1985         goto nosideret;
1986       if (unop_user_defined_p (op, arg1))
1987         return value_x_unop (arg1, op, noside);
1988       else
1989         {
1990           type = language_bool_type (exp->language_defn, exp->gdbarch);
1991           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
1992         }
1993
1994     case UNOP_IND:
1995       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1996         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1997       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1998       type = check_typedef (value_type (arg1));
1999       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2000           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2001         error (_("Attempt to dereference pointer to member without an object"));
2002       if (noside == EVAL_SKIP)
2003         goto nosideret;
2004       if (unop_user_defined_p (op, arg1))
2005         return value_x_unop (arg1, op, noside);
2006       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2007         {
2008           type = check_typedef (value_type (arg1));
2009           if (TYPE_CODE (type) == TYPE_CODE_PTR
2010               || TYPE_CODE (type) == TYPE_CODE_REF
2011           /* In C you can dereference an array to get the 1st elt.  */
2012               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2013             )
2014             return value_zero (TYPE_TARGET_TYPE (type),
2015                                lval_memory);
2016           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2017             /* GDB allows dereferencing an int.  */
2018             return value_zero (builtin_type_int, lval_memory);
2019           else
2020             error (_("Attempt to take contents of a non-pointer value."));
2021         }
2022       return value_ind (arg1);
2023
2024     case UNOP_ADDR:
2025       /* C++: check for and handle pointer to members.  */
2026
2027       op = exp->elts[*pos].opcode;
2028
2029       if (noside == EVAL_SKIP)
2030         {
2031           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2032           goto nosideret;
2033         }
2034       else
2035         {
2036           struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
2037           return retvalp;
2038         }
2039
2040     case UNOP_SIZEOF:
2041       if (noside == EVAL_SKIP)
2042         {
2043           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2044           goto nosideret;
2045         }
2046       return evaluate_subexp_for_sizeof (exp, pos);
2047
2048     case UNOP_CAST:
2049       (*pos) += 2;
2050       type = exp->elts[pc + 1].type;
2051       arg1 = evaluate_subexp (type, exp, pos, noside);
2052       if (noside == EVAL_SKIP)
2053         goto nosideret;
2054       if (type != value_type (arg1))
2055         arg1 = value_cast (type, arg1);
2056       return arg1;
2057
2058     case UNOP_MEMVAL:
2059       (*pos) += 2;
2060       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2061       if (noside == EVAL_SKIP)
2062         goto nosideret;
2063       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2064         return value_zero (exp->elts[pc + 1].type, lval_memory);
2065       else
2066         return value_at_lazy (exp->elts[pc + 1].type,
2067                               value_as_address (arg1));
2068
2069     case UNOP_MEMVAL_TLS:
2070       (*pos) += 3;
2071       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2072       if (noside == EVAL_SKIP)
2073         goto nosideret;
2074       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2075         return value_zero (exp->elts[pc + 2].type, lval_memory);
2076       else
2077         {
2078           CORE_ADDR tls_addr;
2079           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2080                                                    value_as_address (arg1));
2081           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2082         }
2083
2084     case UNOP_PREINCREMENT:
2085       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2086       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2087         return arg1;
2088       else if (unop_user_defined_p (op, arg1))
2089         {
2090           return value_x_unop (arg1, op, noside);
2091         }
2092       else
2093         {
2094           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2095                                                       (LONGEST) 1));
2096           return value_assign (arg1, arg2);
2097         }
2098
2099     case UNOP_PREDECREMENT:
2100       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2101       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2102         return arg1;
2103       else if (unop_user_defined_p (op, arg1))
2104         {
2105           return value_x_unop (arg1, op, noside);
2106         }
2107       else
2108         {
2109           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2110                                                       (LONGEST) 1));
2111           return value_assign (arg1, arg2);
2112         }
2113
2114     case UNOP_POSTINCREMENT:
2115       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2116       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2117         return arg1;
2118       else if (unop_user_defined_p (op, arg1))
2119         {
2120           return value_x_unop (arg1, op, noside);
2121         }
2122       else
2123         {
2124           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2125                                                       (LONGEST) 1));
2126           value_assign (arg1, arg2);
2127           return arg1;
2128         }
2129
2130     case UNOP_POSTDECREMENT:
2131       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2132       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2133         return arg1;
2134       else if (unop_user_defined_p (op, arg1))
2135         {
2136           return value_x_unop (arg1, op, noside);
2137         }
2138       else
2139         {
2140           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2141                                                       (LONGEST) 1));
2142           value_assign (arg1, arg2);
2143           return arg1;
2144         }
2145
2146     case OP_THIS:
2147       (*pos) += 1;
2148       return value_of_this (1);
2149
2150     case OP_OBJC_SELF:
2151       (*pos) += 1;
2152       return value_of_local ("self", 1);
2153
2154     case OP_TYPE:
2155       /* The value is not supposed to be used.  This is here to make it
2156          easier to accommodate expressions that contain types.  */
2157       (*pos) += 2;
2158       if (noside == EVAL_SKIP)
2159         goto nosideret;
2160       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2161         return allocate_value (exp->elts[pc + 1].type);
2162       else
2163         error (_("Attempt to use a type name as an expression"));
2164
2165     default:
2166       /* Removing this case and compiling with gcc -Wall reveals that
2167          a lot of cases are hitting this case.  Some of these should
2168          probably be removed from expression.h; others are legitimate
2169          expressions which are (apparently) not fully implemented.
2170
2171          If there are any cases landing here which mean a user error,
2172          then they should be separate cases, with more descriptive
2173          error messages.  */
2174
2175       error (_("\
2176 GDB does not (yet) know how to evaluate that kind of expression"));
2177     }
2178
2179 nosideret:
2180   return value_from_longest (builtin_type_long, (LONGEST) 1);
2181 }
2182 \f
2183 /* Evaluate a subexpression of EXP, at index *POS,
2184    and return the address of that subexpression.
2185    Advance *POS over the subexpression.
2186    If the subexpression isn't an lvalue, get an error.
2187    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2188    then only the type of the result need be correct.  */
2189
2190 static struct value *
2191 evaluate_subexp_for_address (struct expression *exp, int *pos,
2192                              enum noside noside)
2193 {
2194   enum exp_opcode op;
2195   int pc;
2196   struct symbol *var;
2197   struct value *x;
2198   int tem;
2199
2200   pc = (*pos);
2201   op = exp->elts[pc].opcode;
2202
2203   switch (op)
2204     {
2205     case UNOP_IND:
2206       (*pos)++;
2207       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2208
2209       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2210       if (unop_user_defined_p (op, x))
2211         {
2212           x = value_x_unop (x, op, noside);
2213           goto default_case_after_eval;
2214         }
2215
2216       return x;
2217
2218     case UNOP_MEMVAL:
2219       (*pos) += 3;
2220       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2221                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2222
2223     case OP_VAR_VALUE:
2224       var = exp->elts[pc + 2].symbol;
2225
2226       /* C++: The "address" of a reference should yield the address
2227        * of the object pointed to. Let value_addr() deal with it. */
2228       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2229         goto default_case;
2230
2231       (*pos) += 4;
2232       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2233         {
2234           struct type *type =
2235           lookup_pointer_type (SYMBOL_TYPE (var));
2236           enum address_class sym_class = SYMBOL_CLASS (var);
2237
2238           if (sym_class == LOC_CONST
2239               || sym_class == LOC_CONST_BYTES
2240               || sym_class == LOC_REGISTER)
2241             error (_("Attempt to take address of register or constant."));
2242
2243           return
2244             value_zero (type, not_lval);
2245         }
2246       else if (symbol_read_needs_frame (var))
2247         return
2248           locate_var_value
2249           (var,
2250            block_innermost_frame (exp->elts[pc + 1].block));
2251       else
2252         return locate_var_value (var, NULL);
2253
2254     case OP_SCOPE:
2255       tem = longest_to_int (exp->elts[pc + 2].longconst);
2256       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2257       x = value_aggregate_elt (exp->elts[pc + 1].type,
2258                                &exp->elts[pc + 3].string,
2259                                1, noside);
2260       if (x == NULL)
2261         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2262       return x;
2263
2264     default:
2265     default_case:
2266       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2267     default_case_after_eval:
2268       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2269         {
2270           struct type *type = check_typedef (value_type (x));
2271
2272           if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2273             return value_zero (lookup_pointer_type (value_type (x)),
2274                                not_lval);
2275           else if (TYPE_CODE (type) == TYPE_CODE_REF)
2276             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2277                                not_lval);
2278           else
2279             error (_("Attempt to take address of value not located in memory."));
2280         }
2281       return value_addr (x);
2282     }
2283 }
2284
2285 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2286    When used in contexts where arrays will be coerced anyway, this is
2287    equivalent to `evaluate_subexp' but much faster because it avoids
2288    actually fetching array contents (perhaps obsolete now that we have
2289    value_lazy()).
2290
2291    Note that we currently only do the coercion for C expressions, where
2292    arrays are zero based and the coercion is correct.  For other languages,
2293    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2294    to decide if coercion is appropriate.
2295
2296  */
2297
2298 struct value *
2299 evaluate_subexp_with_coercion (struct expression *exp,
2300                                int *pos, enum noside noside)
2301 {
2302   enum exp_opcode op;
2303   int pc;
2304   struct value *val;
2305   struct symbol *var;
2306
2307   pc = (*pos);
2308   op = exp->elts[pc].opcode;
2309
2310   switch (op)
2311     {
2312     case OP_VAR_VALUE:
2313       var = exp->elts[pc + 2].symbol;
2314       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2315           && CAST_IS_CONVERSION)
2316         {
2317           (*pos) += 4;
2318           val =
2319             locate_var_value
2320             (var, block_innermost_frame (exp->elts[pc + 1].block));
2321           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2322                              val);
2323         }
2324       /* FALLTHROUGH */
2325
2326     default:
2327       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2328     }
2329 }
2330
2331 /* Evaluate a subexpression of EXP, at index *POS,
2332    and return a value for the size of that subexpression.
2333    Advance *POS over the subexpression.  */
2334
2335 static struct value *
2336 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2337 {
2338   enum exp_opcode op;
2339   int pc;
2340   struct type *type;
2341   struct value *val;
2342
2343   pc = (*pos);
2344   op = exp->elts[pc].opcode;
2345
2346   switch (op)
2347     {
2348       /* This case is handled specially
2349          so that we avoid creating a value for the result type.
2350          If the result type is very big, it's desirable not to
2351          create a value unnecessarily.  */
2352     case UNOP_IND:
2353       (*pos)++;
2354       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2355       type = check_typedef (value_type (val));
2356       if (TYPE_CODE (type) != TYPE_CODE_PTR
2357           && TYPE_CODE (type) != TYPE_CODE_REF
2358           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2359         error (_("Attempt to take contents of a non-pointer value."));
2360       type = check_typedef (TYPE_TARGET_TYPE (type));
2361       return value_from_longest (builtin_type_int, (LONGEST)
2362                                  TYPE_LENGTH (type));
2363
2364     case UNOP_MEMVAL:
2365       (*pos) += 3;
2366       type = check_typedef (exp->elts[pc + 1].type);
2367       return value_from_longest (builtin_type_int,
2368                                  (LONGEST) TYPE_LENGTH (type));
2369
2370     case OP_VAR_VALUE:
2371       (*pos) += 4;
2372       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2373       return
2374         value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
2375
2376     default:
2377       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2378       return value_from_longest (builtin_type_int,
2379                                  (LONGEST) TYPE_LENGTH (value_type (val)));
2380     }
2381 }
2382
2383 /* Parse a type expression in the string [P..P+LENGTH). */
2384
2385 struct type *
2386 parse_and_eval_type (char *p, int length)
2387 {
2388   char *tmp = (char *) alloca (length + 4);
2389   struct expression *expr;
2390   tmp[0] = '(';
2391   memcpy (tmp + 1, p, length);
2392   tmp[length + 1] = ')';
2393   tmp[length + 2] = '0';
2394   tmp[length + 3] = '\0';
2395   expr = parse_expression (tmp);
2396   if (expr->elts[0].opcode != UNOP_CAST)
2397     error (_("Internal error in eval_type."));
2398   return expr->elts[1].type;
2399 }
2400
2401 int
2402 calc_f77_array_dims (struct type *array_type)
2403 {
2404   int ndimen = 1;
2405   struct type *tmp_type;
2406
2407   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2408     error (_("Can't get dimensions for a non-array type"));
2409
2410   tmp_type = array_type;
2411
2412   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2413     {
2414       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2415         ++ndimen;
2416     }
2417   return ndimen;
2418 }