gdb/eval.c

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