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