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