contrib/gdb-6.2.1/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 ());
 451         (*pos) += 2;
 452         if (val == NULL)
 453           error ("Value of register %s not available.",
 454                  frame_map_regnum_to_name (get_selected_frame (), 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             VALUE_TYPE (argvec[0]) = lookup_function_type
 949                             (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               VALUE_TYPE (arg1) = 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           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 + 1];      /* 1-based array of
1614                                                            subscripts, max == 7 */
1615         int array_size_array[MAX_FORTRAN_DIMS + 1];
1616         int ndimensions = 1, i;
1617         struct type *tmp_type;
1618         int offset_item;        /* The array offset where the item lives */
1619
1620         if (nargs > MAX_FORTRAN_DIMS)
1621           error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
1622
1623         tmp_type = check_typedef (VALUE_TYPE (arg1));
1624         ndimensions = calc_f77_array_dims (type);
1625
1626         if (nargs != ndimensions)
1627           error ("Wrong number of subscripts");
1628
1629         /* Now that we know we have a legal array subscript expression
1630            let us actually find out where this element exists in the array. */
1631
1632         offset_item = 0;
1633         for (i = 1; 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             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1643             if (retcode == BOUND_FETCH_ERROR)
1644               error ("Cannot obtain dynamic upper bound");
1645
1646             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1647             if (retcode == BOUND_FETCH_ERROR)
1648               error ("Cannot obtain dynamic lower bound");
1649
1650             array_size_array[i] = upper - lower + 1;
1651
1652             /* Zero-normalize subscripts so that offsetting will work. */
1653
1654             subscript_array[i] -= lower;
1655
1656             /* If we are at the bottom of a multidimensional
1657                array type then keep a ptr to the last ARRAY
1658                type around for use when calling value_subscript()
1659                below. This is done because we pretend to value_subscript
1660                that we actually have a one-dimensional array
1661                of base element type that we apply a simple
1662                offset to. */
1663
1664             if (i < nargs)
1665               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1666           }
1667
1668         /* Now let us calculate the offset for this item */
1669
1670         offset_item = subscript_array[ndimensions];
1671
1672         for (i = ndimensions - 1; i >= 1; i--)
1673           offset_item =
1674             array_size_array[i] * offset_item + subscript_array[i];
1675
1676         /* Construct a value node with the value of the offset */
1677
1678         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1679
1680         /* Let us now play a dirty trick: we will take arg1
1681            which is a value node pointing to the topmost level
1682            of the multidimensional array-set and pretend
1683            that it is actually a array of the final element
1684            type, this will ensure that value_subscript()
1685            returns the correct type value */
1686
1687         VALUE_TYPE (arg1) = tmp_type;
1688         return value_ind (value_add (value_coerce_array (arg1), arg2));
1689       }
1690
1691     case BINOP_LOGICAL_AND:
1692       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1693       if (noside == EVAL_SKIP)
1694         {
1695           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1696           goto nosideret;
1697         }
1698
1699       oldpos = *pos;
1700       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1701       *pos = oldpos;
1702
1703       if (binop_user_defined_p (op, arg1, arg2))
1704         {
1705           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1706           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1707         }
1708       else
1709         {
1710           tem = value_logical_not (arg1);
1711           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1712                                   (tem ? EVAL_SKIP : noside));
1713           return value_from_longest (LA_BOOL_TYPE,
1714                              (LONGEST) (!tem && !value_logical_not (arg2)));
1715         }
1716
1717     case BINOP_LOGICAL_OR:
1718       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1719       if (noside == EVAL_SKIP)
1720         {
1721           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1722           goto nosideret;
1723         }
1724
1725       oldpos = *pos;
1726       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1727       *pos = oldpos;
1728
1729       if (binop_user_defined_p (op, arg1, arg2))
1730         {
1731           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1732           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1733         }
1734       else
1735         {
1736           tem = value_logical_not (arg1);
1737           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1738                                   (!tem ? EVAL_SKIP : noside));
1739           return value_from_longest (LA_BOOL_TYPE,
1740                              (LONGEST) (!tem || !value_logical_not (arg2)));
1741         }
1742
1743     case BINOP_EQUAL:
1744       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1745       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1746       if (noside == EVAL_SKIP)
1747         goto nosideret;
1748       if (binop_user_defined_p (op, arg1, arg2))
1749         {
1750           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1751         }
1752       else
1753         {
1754           tem = value_equal (arg1, arg2);
1755           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1756         }
1757
1758     case BINOP_NOTEQUAL:
1759       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1760       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1761       if (noside == EVAL_SKIP)
1762         goto nosideret;
1763       if (binop_user_defined_p (op, arg1, arg2))
1764         {
1765           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1766         }
1767       else
1768         {
1769           tem = value_equal (arg1, arg2);
1770           return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1771         }
1772
1773     case BINOP_LESS:
1774       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1775       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1776       if (noside == EVAL_SKIP)
1777         goto nosideret;
1778       if (binop_user_defined_p (op, arg1, arg2))
1779         {
1780           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1781         }
1782       else
1783         {
1784           tem = value_less (arg1, arg2);
1785           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1786         }
1787
1788     case BINOP_GTR:
1789       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1790       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1791       if (noside == EVAL_SKIP)
1792         goto nosideret;
1793       if (binop_user_defined_p (op, arg1, arg2))
1794         {
1795           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1796         }
1797       else
1798         {
1799           tem = value_less (arg2, arg1);
1800           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1801         }
1802
1803     case BINOP_GEQ:
1804       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1805       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1806       if (noside == EVAL_SKIP)
1807         goto nosideret;
1808       if (binop_user_defined_p (op, arg1, arg2))
1809         {
1810           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1811         }
1812       else
1813         {
1814           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1815           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1816         }
1817
1818     case BINOP_LEQ:
1819       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1820       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1821       if (noside == EVAL_SKIP)
1822         goto nosideret;
1823       if (binop_user_defined_p (op, arg1, arg2))
1824         {
1825           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1826         }
1827       else
1828         {
1829           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1830           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1831         }
1832
1833     case BINOP_REPEAT:
1834       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1835       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1836       if (noside == EVAL_SKIP)
1837         goto nosideret;
1838       type = check_typedef (VALUE_TYPE (arg2));
1839       if (TYPE_CODE (type) != TYPE_CODE_INT)
1840         error ("Non-integral right operand for \"@\" operator.");
1841       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1842         {
1843           return allocate_repeat_value (VALUE_TYPE (arg1),
1844                                      longest_to_int (value_as_long (arg2)));
1845         }
1846       else
1847         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1848
1849     case BINOP_COMMA:
1850       evaluate_subexp (NULL_TYPE, exp, pos, noside);
1851       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1852
1853     case UNOP_NEG:
1854       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1855       if (noside == EVAL_SKIP)
1856         goto nosideret;
1857       if (unop_user_defined_p (op, arg1))
1858         return value_x_unop (arg1, op, noside);
1859       else
1860         return value_neg (arg1);
1861
1862     case UNOP_COMPLEMENT:
1863       /* C++: check for and handle destructor names.  */
1864       op = exp->elts[*pos].opcode;
1865
1866       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1867       if (noside == EVAL_SKIP)
1868         goto nosideret;
1869       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1870         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1871       else
1872         return value_complement (arg1);
1873
1874     case UNOP_LOGICAL_NOT:
1875       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1876       if (noside == EVAL_SKIP)
1877         goto nosideret;
1878       if (unop_user_defined_p (op, arg1))
1879         return value_x_unop (arg1, op, noside);
1880       else
1881         return value_from_longest (LA_BOOL_TYPE,
1882                                    (LONGEST) value_logical_not (arg1));
1883
1884     case UNOP_IND:
1885       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1886         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1887       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1888       if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
1889           ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
1890            (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
1891         error ("Attempt to dereference pointer to member without an object");
1892       if (noside == EVAL_SKIP)
1893         goto nosideret;
1894       if (unop_user_defined_p (op, arg1))
1895         return value_x_unop (arg1, op, noside);
1896       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1897         {
1898           type = check_typedef (VALUE_TYPE (arg1));
1899           if (TYPE_CODE (type) == TYPE_CODE_PTR
1900               || TYPE_CODE (type) == TYPE_CODE_REF
1901           /* In C you can dereference an array to get the 1st elt.  */
1902               || TYPE_CODE (type) == TYPE_CODE_ARRAY
1903             )
1904             return value_zero (TYPE_TARGET_TYPE (type),
1905                                lval_memory);
1906           else if (TYPE_CODE (type) == TYPE_CODE_INT)
1907             /* GDB allows dereferencing an int.  */
1908             return value_zero (builtin_type_int, lval_memory);
1909           else
1910             error ("Attempt to take contents of a non-pointer value.");
1911         }
1912       return value_ind (arg1);
1913
1914     case UNOP_ADDR:
1915       /* C++: check for and handle pointer to members.  */
1916
1917       op = exp->elts[*pos].opcode;
1918
1919       if (noside == EVAL_SKIP)
1920         {
1921           if (op == OP_SCOPE)
1922             {
1923               int temm = longest_to_int (exp->elts[pc + 3].longconst);
1924               (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1925             }
1926           else
1927             evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1928           goto nosideret;
1929         }
1930       else
1931         {
1932           struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
1933           /* If HP aCC object, use bias for pointers to members */
1934           if (deprecated_hp_som_som_object_present &&
1935               (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
1936               (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
1937             {
1938               unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp);    /* forces evaluation */
1939               *ptr |= 0x20000000;       /* set 29th bit */
1940             }
1941           return retvalp;
1942         }
1943
1944     case UNOP_SIZEOF:
1945       if (noside == EVAL_SKIP)
1946         {
1947           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1948           goto nosideret;
1949         }
1950       return evaluate_subexp_for_sizeof (exp, pos);
1951
1952     case UNOP_CAST:
1953       (*pos) += 2;
1954       type = exp->elts[pc + 1].type;
1955       arg1 = evaluate_subexp (type, exp, pos, noside);
1956       if (noside == EVAL_SKIP)
1957         goto nosideret;
1958       if (type != VALUE_TYPE (arg1))
1959         arg1 = value_cast (type, arg1);
1960       return arg1;
1961
1962     case UNOP_MEMVAL:
1963       (*pos) += 2;
1964       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1965       if (noside == EVAL_SKIP)
1966         goto nosideret;
1967       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1968         return value_zero (exp->elts[pc + 1].type, lval_memory);
1969       else
1970         return value_at_lazy (exp->elts[pc + 1].type,
1971                               value_as_address (arg1),
1972                               NULL);
1973
1974     case UNOP_PREINCREMENT:
1975       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1976       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1977         return arg1;
1978       else if (unop_user_defined_p (op, arg1))
1979         {
1980           return value_x_unop (arg1, op, noside);
1981         }
1982       else
1983         {
1984           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1985                                                       (LONGEST) 1));
1986           return value_assign (arg1, arg2);
1987         }
1988
1989     case UNOP_PREDECREMENT:
1990       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1991       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1992         return arg1;
1993       else if (unop_user_defined_p (op, arg1))
1994         {
1995           return value_x_unop (arg1, op, noside);
1996         }
1997       else
1998         {
1999           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2000                                                       (LONGEST) 1));
2001           return value_assign (arg1, arg2);
2002         }
2003
2004     case UNOP_POSTINCREMENT:
2005       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2006       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2007         return arg1;
2008       else if (unop_user_defined_p (op, arg1))
2009         {
2010           return value_x_unop (arg1, op, noside);
2011         }
2012       else
2013         {
2014           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2015                                                       (LONGEST) 1));
2016           value_assign (arg1, arg2);
2017           return arg1;
2018         }
2019
2020     case UNOP_POSTDECREMENT:
2021       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2022       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2023         return arg1;
2024       else if (unop_user_defined_p (op, arg1))
2025         {
2026           return value_x_unop (arg1, op, noside);
2027         }
2028       else
2029         {
2030           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2031                                                       (LONGEST) 1));
2032           value_assign (arg1, arg2);
2033           return arg1;
2034         }
2035
2036     case OP_THIS:
2037       (*pos) += 1;
2038       return value_of_this (1);
2039
2040     case OP_OBJC_SELF:
2041       (*pos) += 1;
2042       return value_of_local ("self", 1);
2043
2044     case OP_TYPE:
2045       error ("Attempt to use a type name as an expression");
2046
2047     default:
2048       /* Removing this case and compiling with gcc -Wall reveals that
2049          a lot of cases are hitting this case.  Some of these should
2050          probably be removed from expression.h; others are legitimate
2051          expressions which are (apparently) not fully implemented.
2052
2053          If there are any cases landing here which mean a user error,
2054          then they should be separate cases, with more descriptive
2055          error messages.  */
2056
2057       error ("\
2058 GDB does not (yet) know how to evaluate that kind of expression");
2059     }
2060
2061 nosideret:
2062   return value_from_longest (builtin_type_long, (LONGEST) 1);
2063 }
2064 \f
2065 /* Evaluate a subexpression of EXP, at index *POS,
2066    and return the address of that subexpression.
2067    Advance *POS over the subexpression.
2068    If the subexpression isn't an lvalue, get an error.
2069    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2070    then only the type of the result need be correct.  */
2071
2072 static struct value *
2073 evaluate_subexp_for_address (struct expression *exp, int *pos,
2074                              enum noside noside)
2075 {
2076   enum exp_opcode op;
2077   int pc;
2078   struct symbol *var;
2079
2080   pc = (*pos);
2081   op = exp->elts[pc].opcode;
2082
2083   switch (op)
2084     {
2085     case UNOP_IND:
2086       (*pos)++;
2087       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2088
2089     case UNOP_MEMVAL:
2090       (*pos) += 3;
2091       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2092                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2093
2094     case OP_VAR_VALUE:
2095       var = exp->elts[pc + 2].symbol;
2096
2097       /* C++: The "address" of a reference should yield the address
2098        * of the object pointed to. Let value_addr() deal with it. */
2099       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2100         goto default_case;
2101
2102       (*pos) += 4;
2103       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2104         {
2105           struct type *type =
2106           lookup_pointer_type (SYMBOL_TYPE (var));
2107           enum address_class sym_class = SYMBOL_CLASS (var);
2108
2109           if (sym_class == LOC_CONST
2110               || sym_class == LOC_CONST_BYTES
2111               || sym_class == LOC_REGISTER
2112               || sym_class == LOC_REGPARM)
2113             error ("Attempt to take address of register or constant.");
2114
2115           return
2116             value_zero (type, not_lval);
2117         }
2118       else
2119         return
2120           locate_var_value
2121           (var,
2122            block_innermost_frame (exp->elts[pc + 1].block));
2123
2124     default:
2125     default_case:
2126       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2127         {
2128           struct value *x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2129           if (VALUE_LVAL (x) == lval_memory)
2130             return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
2131                                not_lval);
2132           else
2133             error ("Attempt to take address of non-lval");
2134         }
2135       return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
2136     }
2137 }
2138
2139 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2140    When used in contexts where arrays will be coerced anyway, this is
2141    equivalent to `evaluate_subexp' but much faster because it avoids
2142    actually fetching array contents (perhaps obsolete now that we have
2143    VALUE_LAZY).
2144
2145    Note that we currently only do the coercion for C expressions, where
2146    arrays are zero based and the coercion is correct.  For other languages,
2147    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2148    to decide if coercion is appropriate.
2149
2150  */
2151
2152 struct value *
2153 evaluate_subexp_with_coercion (struct expression *exp,
2154                                int *pos, enum noside noside)
2155 {
2156   enum exp_opcode op;
2157   int pc;
2158   struct value *val;
2159   struct symbol *var;
2160
2161   pc = (*pos);
2162   op = exp->elts[pc].opcode;
2163
2164   switch (op)
2165     {
2166     case OP_VAR_VALUE:
2167       var = exp->elts[pc + 2].symbol;
2168       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2169           && CAST_IS_CONVERSION)
2170         {
2171           (*pos) += 4;
2172           val =
2173             locate_var_value
2174             (var, block_innermost_frame (exp->elts[pc + 1].block));
2175           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2176                              val);
2177         }
2178       /* FALLTHROUGH */
2179
2180     default:
2181       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2182     }
2183 }
2184
2185 /* Evaluate a subexpression of EXP, at index *POS,
2186    and return a value for the size of that subexpression.
2187    Advance *POS over the subexpression.  */
2188
2189 static struct value *
2190 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2191 {
2192   enum exp_opcode op;
2193   int pc;
2194   struct type *type;
2195   struct value *val;
2196
2197   pc = (*pos);
2198   op = exp->elts[pc].opcode;
2199
2200   switch (op)
2201     {
2202       /* This case is handled specially
2203          so that we avoid creating a value for the result type.
2204          If the result type is very big, it's desirable not to
2205          create a value unnecessarily.  */
2206     case UNOP_IND:
2207       (*pos)++;
2208       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2209       type = check_typedef (VALUE_TYPE (val));
2210       if (TYPE_CODE (type) != TYPE_CODE_PTR
2211           && TYPE_CODE (type) != TYPE_CODE_REF
2212           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2213         error ("Attempt to take contents of a non-pointer value.");
2214       type = check_typedef (TYPE_TARGET_TYPE (type));
2215       return value_from_longest (builtin_type_int, (LONGEST)
2216                                  TYPE_LENGTH (type));
2217
2218     case UNOP_MEMVAL:
2219       (*pos) += 3;
2220       type = check_typedef (exp->elts[pc + 1].type);
2221       return value_from_longest (builtin_type_int,
2222                                  (LONGEST) TYPE_LENGTH (type));
2223
2224     case OP_VAR_VALUE:
2225       (*pos) += 4;
2226       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2227       return
2228         value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
2229
2230     default:
2231       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2232       return value_from_longest (builtin_type_int,
2233                                  (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
2234     }
2235 }
2236
2237 /* Parse a type expression in the string [P..P+LENGTH). */
2238
2239 struct type *
2240 parse_and_eval_type (char *p, int length)
2241 {
2242   char *tmp = (char *) alloca (length + 4);
2243   struct expression *expr;
2244   tmp[0] = '(';
2245   memcpy (tmp + 1, p, length);
2246   tmp[length + 1] = ')';
2247   tmp[length + 2] = '0';
2248   tmp[length + 3] = '\0';
2249   expr = parse_expression (tmp);
2250   if (expr->elts[0].opcode != UNOP_CAST)
2251     error ("Internal error in eval_type.");
2252   return expr->elts[1].type;
2253 }
2254
2255 int
2256 calc_f77_array_dims (struct type *array_type)
2257 {
2258   int ndimen = 1;
2259   struct type *tmp_type;
2260
2261   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2262     error ("Can't get dimensions for a non-array type");
2263
2264   tmp_type = array_type;
2265
2266   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2267     {
2268       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2269         ++ndimen;
2270     }
2271   return ndimen;
2272 }