gdb/eval.c

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