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