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