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