gdb/eval.c

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