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