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