gdb/eval.c

   1 /* Evaluate expressions for GDB.
   2    Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GDB.
   6
   7 This program is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2 of the License, or
  10 (at your option) any later version.
  11
  12 This program is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program; if not, write to the Free Software
  19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20
  21 #include "defs.h"
  22 #include <string.h>
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "value.h"
  26 #include "expression.h"
  27 #include "target.h"
  28 #include "frame.h"
  29 #include "demangle.h"
  30 #include "language.h"   /* For CAST_IS_CONVERSION */
  31 #include "f-lang.h" /* for array bound stuff */
  32
  33 /* Values of NOSIDE argument to eval_subexp.  */
  34
  35 enum noside
  36 {
  37   EVAL_NORMAL,
  38   EVAL_SKIP,                    /* Only effect is to increment pos.  */
  39   EVAL_AVOID_SIDE_EFFECTS       /* Don't modify any variables or
  40                                    call any functions.  The value
  41                                    returned will have the correct
  42                                    type, and will have an
  43                                    approximately correct lvalue
  44                                    type (inaccuracy: anything that is
  45                                    listed as being in a register in
  46                                    the function in which it was
  47                                    declared will be lval_register).  */
  48 };
  49
  50 /* Prototypes for local functions. */
  51
  52 static value_ptr evaluate_subexp_for_sizeof PARAMS ((struct expression *,
  53                                                      int *));
  54
  55 static value_ptr evaluate_subexp_with_coercion PARAMS ((struct expression *,
  56                                                         int *, enum noside));
  57
  58 static value_ptr evaluate_subexp_for_address PARAMS ((struct expression *,
  59                                                       int *, enum noside));
  60
  61 static value_ptr evaluate_subexp PARAMS ((struct type *, struct expression *,
  62                                           int *, enum noside));
  63
  64 \f
  65 /* Parse the string EXP as a C expression, evaluate it,
  66    and return the result as a number.  */
  67
  68 CORE_ADDR
  69 parse_and_eval_address (exp)
  70      char *exp;
  71 {
  72   struct expression *expr = parse_expression (exp);
  73   register CORE_ADDR addr;
  74   register struct cleanup *old_chain =
  75       make_cleanup (free_current_contents, &expr);
  76
  77   addr = value_as_pointer (evaluate_expression (expr));
  78   do_cleanups (old_chain);
  79   return addr;
  80 }
  81
  82 /* Like parse_and_eval_address but takes a pointer to a char * variable
  83    and advanced that variable across the characters parsed.  */
  84
  85 CORE_ADDR
  86 parse_and_eval_address_1 (expptr)
  87      char **expptr;
  88 {
  89   struct expression *expr = parse_exp_1 (expptr, (struct block *)0, 0);
  90   register CORE_ADDR addr;
  91   register struct cleanup *old_chain =
  92       make_cleanup (free_current_contents, &expr);
  93
  94   addr = value_as_pointer (evaluate_expression (expr));
  95   do_cleanups (old_chain);
  96   return addr;
  97 }
  98
  99 value_ptr
 100 parse_and_eval (exp)
 101      char *exp;
 102 {
 103   struct expression *expr = parse_expression (exp);
 104   register value_ptr val;
 105   register struct cleanup *old_chain
 106     = make_cleanup (free_current_contents, &expr);
 107
 108   val = evaluate_expression (expr);
 109   do_cleanups (old_chain);
 110   return val;
 111 }
 112
 113 /* Parse up to a comma (or to a closeparen)
 114    in the string EXPP as an expression, evaluate it, and return the value.
 115    EXPP is advanced to point to the comma.  */
 116
 117 value_ptr
 118 parse_to_comma_and_eval (expp)
 119      char **expp;
 120 {
 121   struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
 122   register value_ptr val;
 123   register struct cleanup *old_chain
 124     = make_cleanup (free_current_contents, &expr);
 125
 126   val = evaluate_expression (expr);
 127   do_cleanups (old_chain);
 128   return val;
 129 }
 130 \f
 131 /* Evaluate an expression in internal prefix form
 132    such as is constructed by parse.y.
 133
 134    See expression.h for info on the format of an expression.  */
 135
 136 value_ptr
 137 evaluate_expression (exp)
 138      struct expression *exp;
 139 {
 140   int pc = 0;
 141   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
 142 }
 143
 144 /* Evaluate an expression, avoiding all memory references
 145    and getting a value whose type alone is correct.  */
 146
 147 value_ptr
 148 evaluate_type (exp)
 149      struct expression *exp;
 150 {
 151   int pc = 0;
 152   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
 153 }
 154
 155 /* Helper function called by evaluate_subexp to initialize a field
 156    a structure from a tuple in Chill.  This is recursive, to handle
 157    more than one field name labels.
 158
 159    STRUCT_VAL is the structure value we are constructing.
 160    (*FIELDNOP) is the field to set, if there is no label.
 161    It is set to the field following this one.
 162    EXP, POS, and NOSIDE are as for evaluate_subexp.
 163
 164    This function does not handle variant records.  FIXME */
 165
 166 static value_ptr
 167 evaluate_labeled_field_init (struct_val, fieldnop, exp, pos, noside)
 168      value_ptr struct_val;
 169      int *fieldnop;
 170      register struct expression *exp;
 171      register int *pos;
 172      enum noside noside;
 173 {
 174   int fieldno = *fieldnop;
 175   value_ptr val;
 176   int bitpos, bitsize;
 177   char *addr;
 178   struct type *struct_type = VALUE_TYPE (struct_val);
 179   if (exp->elts[*pos].opcode == OP_LABELED)
 180     {
 181       int pc = (*pos)++;
 182       char *name = &exp->elts[pc + 2].string;
 183       int tem = longest_to_int (exp->elts[pc + 1].longconst);
 184       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 185       for (fieldno = 0; ; fieldno++)
 186         {
 187           if (fieldno >= TYPE_NFIELDS (struct_type))
 188             error ("there is no field named %s", name);
 189           if (STREQ (TYPE_FIELD_NAME (struct_type, fieldno), name))
 190             break;
 191         }
 192       *fieldnop = fieldno;
 193       val = evaluate_labeled_field_init (struct_val, fieldnop,
 194                                          exp, pos, noside);
 195     }
 196   else
 197     {
 198       fieldno = (*fieldnop)++;
 199       if (fieldno >= TYPE_NFIELDS (struct_type))
 200         error ("too many initializers");
 201       val = evaluate_subexp (TYPE_FIELD_TYPE (struct_type, fieldno),
 202                              exp, pos, noside);
 203     }
 204
 205   /* Assign val to field fieldno. */
 206   if (VALUE_TYPE (val) != TYPE_FIELD_TYPE (struct_type, fieldno))
 207     val = value_cast (TYPE_FIELD_TYPE (struct_type, fieldno), val);
 208 #if 1
 209   bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
 210   bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
 211   addr = VALUE_CONTENTS (struct_val);
 212   addr += bitpos / 8;
 213   if (bitsize)
 214     modify_field (addr, value_as_long (val),
 215                   bitpos % 8, bitsize);
 216   else
 217     memcpy (addr, VALUE_CONTENTS (val),
 218             TYPE_LENGTH (VALUE_TYPE (val)));
 219 #else
 220   value_assign (value_primitive_field (struct_val, 0, fieldno, struct_type),
 221                 val);
 222 #endif
 223   return val;
 224 }
 225
 226 static value_ptr
 227 evaluate_subexp (expect_type, exp, pos, noside)
 228      struct type *expect_type;
 229      register struct expression *exp;
 230      register int *pos;
 231      enum noside noside;
 232 {
 233   enum exp_opcode op;
 234   int tem, tem2, tem3;
 235   register int pc, pc2 = 0, oldpos;
 236   register value_ptr arg1 = NULL, arg2 = NULL, arg3;
 237   struct type *type;
 238   int nargs;
 239   value_ptr *argvec;
 240   struct symbol *tmp_symbol;
 241   int upper, lower, retcode;
 242   int code;
 243   struct internalvar *var;
 244
 245   /* This expect_type crap should not be used for C.  C expressions do
 246      not have any notion of expected types, never has and (goddess
 247      willing) never will.  The C++ code uses it for some twisted
 248      purpose (I haven't investigated but I suspect it just the usual
 249      combination of Stroustrup figuring out some crazy language
 250      feature and Tiemann figuring out some crazier way to try to
 251      implement it).  CHILL has the tuple stuff; I don't know enough
 252      about CHILL to know whether expected types is the way to do it.
 253      FORTRAN I don't know.  */
 254   if (exp->language_defn->la_language != language_cplus
 255       && exp->language_defn->la_language != language_chill)
 256     expect_type = NULL_TYPE;
 257
 258   pc = (*pos)++;
 259   op = exp->elts[pc].opcode;
 260
 261   switch (op)
 262     {
 263     case OP_SCOPE:
 264       tem = longest_to_int (exp->elts[pc + 2].longconst);
 265       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
 266       arg1 = value_struct_elt_for_reference (exp->elts[pc + 1].type,
 267                                              0,
 268                                              exp->elts[pc + 1].type,
 269                                              &exp->elts[pc + 3].string,
 270                                              expect_type);
 271       if (arg1 == NULL)
 272         error ("There is no field named %s", &exp->elts[pc + 3].string);
 273       return arg1;
 274
 275     case OP_LONG:
 276       (*pos) += 3;
 277       return value_from_longest (exp->elts[pc + 1].type,
 278                                  exp->elts[pc + 2].longconst);
 279
 280     case OP_DOUBLE:
 281       (*pos) += 3;
 282       return value_from_double (exp->elts[pc + 1].type,
 283                                 exp->elts[pc + 2].doubleconst);
 284
 285     case OP_VAR_VALUE:
 286       (*pos) += 3;
 287       if (noside == EVAL_SKIP)
 288         goto nosideret;
 289       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 290         {
 291           struct symbol * sym = exp->elts[pc + 2].symbol;
 292           enum lval_type lv;
 293
 294           switch (SYMBOL_CLASS (sym))
 295             {
 296             case LOC_CONST:
 297             case LOC_LABEL:
 298             case LOC_CONST_BYTES:
 299               lv = not_lval;
 300               break;
 301
 302             case LOC_REGISTER:
 303             case LOC_REGPARM:
 304               lv = lval_register;
 305               break;
 306
 307             default:
 308               lv = lval_memory;
 309               break;
 310             }
 311
 312           return value_zero (SYMBOL_TYPE (sym), lv);
 313         }
 314       else
 315         return value_of_variable (exp->elts[pc + 2].symbol,
 316                                   exp->elts[pc + 1].block);
 317
 318     case OP_LAST:
 319       (*pos) += 2;
 320       return
 321         access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
 322
 323     case OP_REGISTER:
 324       (*pos) += 2;
 325       return value_of_register (longest_to_int (exp->elts[pc + 1].longconst));
 326
 327     case OP_BOOL:
 328       (*pos) += 2;
 329       if (current_language->la_language == language_fortran)
 330         return value_from_longest (builtin_type_f_logical_s2,
 331                                    exp->elts[pc + 1].longconst);
 332       else
 333         return value_from_longest (builtin_type_chill_bool,
 334                                    exp->elts[pc + 1].longconst);
 335
 336     case OP_INTERNALVAR:
 337       (*pos) += 2;
 338       return value_of_internalvar (exp->elts[pc + 1].internalvar);
 339
 340     case OP_STRING:
 341       tem = longest_to_int (exp->elts[pc + 1].longconst);
 342       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 343       if (noside == EVAL_SKIP)
 344         goto nosideret;
 345       return value_string (&exp->elts[pc + 2].string, tem);
 346
 347     case OP_BITSTRING:
 348       tem = longest_to_int (exp->elts[pc + 1].longconst);
 349       (*pos)
 350         += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
 351       if (noside == EVAL_SKIP)
 352         goto nosideret;
 353       return value_bitstring (&exp->elts[pc + 2].string, tem);
 354       break;
 355
 356     case OP_ARRAY:
 357       (*pos) += 3;
 358       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 359       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 360       nargs = tem3 - tem2 + 1;
 361
 362       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 363           && TYPE_CODE (expect_type) == TYPE_CODE_STRUCT)
 364         {
 365           value_ptr rec = allocate_value (expect_type);
 366           int fieldno = 0;
 367           memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
 368           for (tem = 0; tem < nargs; tem++)
 369             evaluate_labeled_field_init (rec, &fieldno, exp, pos, noside);
 370           return rec;
 371         }
 372
 373       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 374           && TYPE_CODE (expect_type) == TYPE_CODE_ARRAY)
 375         {
 376           struct type *range_type = TYPE_FIELD_TYPE (expect_type, 0);
 377           struct type *element_type = TYPE_TARGET_TYPE (expect_type);
 378           LONGEST low_bound =  TYPE_FIELD_BITPOS (range_type, 0);
 379           LONGEST high_bound = TYPE_FIELD_BITPOS (range_type, 1);
 380           int element_size = TYPE_LENGTH (element_type);
 381           value_ptr array = allocate_value (expect_type);
 382           if (nargs != (high_bound - low_bound + 1))
 383             error ("wrong number of initialiers for array type");
 384           for (tem = low_bound;  tem <= high_bound;  tem++)
 385             {
 386               value_ptr element = evaluate_subexp (element_type,
 387                                                    exp, pos, noside);
 388               if (VALUE_TYPE (element) != element_type)
 389                 element = value_cast (element_type, element);
 390               memcpy (VALUE_CONTENTS_RAW (array)
 391                       + (tem - low_bound) * element_size,
 392                       VALUE_CONTENTS (element),
 393                       element_size);
 394             }
 395           return array;
 396         }
 397
 398       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 399           && TYPE_CODE (expect_type) == TYPE_CODE_SET)
 400         {
 401           value_ptr set = allocate_value (expect_type);
 402           struct type *element_type = TYPE_INDEX_TYPE (expect_type);
 403           int low_bound = TYPE_LOW_BOUND (element_type);
 404           int high_bound = TYPE_HIGH_BOUND (element_type);
 405           char *valaddr = VALUE_CONTENTS_RAW (set);
 406           memset (valaddr, '\0', TYPE_LENGTH (expect_type));
 407           for (tem = 0; tem < nargs; tem++)
 408             {
 409               value_ptr element_val = evaluate_subexp (element_type,
 410                                                        exp, pos, noside);
 411               LONGEST element = value_as_long (element_val);
 412               int bit_index;
 413               if (element < low_bound || element > high_bound)
 414                 error ("POWERSET tuple element out of range");
 415               element -= low_bound;
 416               bit_index = (unsigned) element % TARGET_CHAR_BIT;
 417               if (BITS_BIG_ENDIAN)
 418                 bit_index = TARGET_CHAR_BIT - 1 - bit_index;
 419               valaddr [(unsigned) element / TARGET_CHAR_BIT] |= 1 << bit_index;
 420             }
 421           return set;
 422         }
 423
 424       argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
 425       for (tem = 0; tem < nargs; tem++)
 426         {
 427           /* Ensure that array expressions are coerced into pointer objects. */
 428           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 429         }
 430       if (noside == EVAL_SKIP)
 431         goto nosideret;
 432       return value_array (tem2, tem3, argvec);
 433
 434     case TERNOP_SLICE:
 435       {
 436         value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 437         int lowbound
 438           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 439         int upper
 440           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 441         return value_slice (array, lowbound, upper - lowbound + 1);
 442       }
 443
 444     case TERNOP_SLICE_COUNT:
 445       {
 446         value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 447         int lowbound
 448           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 449         int length
 450           = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 451         return value_slice (array, lowbound, length);
 452       }
 453
 454     case TERNOP_COND:
 455       /* Skip third and second args to evaluate the first one.  */
 456       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 457       if (value_logical_not (arg1))
 458         {
 459           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 460           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 461         }
 462       else
 463         {
 464           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 465           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 466           return arg2;
 467         }
 468
 469     case OP_FUNCALL:
 470       (*pos) += 2;
 471       op = exp->elts[*pos].opcode;
 472       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 473         {
 474           LONGEST fnptr;
 475
 476           nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
 477           /* First, evaluate the structure into arg2 */
 478           pc2 = (*pos)++;
 479
 480           if (noside == EVAL_SKIP)
 481             goto nosideret;
 482
 483           if (op == STRUCTOP_MEMBER)
 484             {
 485               arg2 = evaluate_subexp_for_address (exp, pos, noside);
 486             }
 487           else
 488             {
 489               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 490             }
 491
 492           /* If the function is a virtual function, then the
 493              aggregate value (providing the structure) plays
 494              its part by providing the vtable.  Otherwise,
 495              it is just along for the ride: call the function
 496              directly.  */
 497
 498           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 499
 500           fnptr = value_as_long (arg1);
 501
 502           if (METHOD_PTR_IS_VIRTUAL(fnptr))
 503             {
 504               int fnoffset = METHOD_PTR_TO_VOFFSET(fnptr);
 505               struct type *basetype;
 506               struct type *domain_type =
 507                   TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
 508               int i, j;
 509               basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
 510               if (domain_type != basetype)
 511                   arg2 = value_cast(lookup_pointer_type (domain_type), arg2);
 512               basetype = TYPE_VPTR_BASETYPE (domain_type);
 513               for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
 514                 {
 515                   struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
 516                   /* If one is virtual, then all are virtual.  */
 517                   if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
 518                     for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
 519                       if (TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
 520                         {
 521                           value_ptr temp = value_ind (arg2);
 522                           arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
 523                           arg2 = value_addr (temp);
 524                           goto got_it;
 525                         }
 526                 }
 527               if (i < 0)
 528                 error ("virtual function at index %d not found", fnoffset);
 529             }
 530           else
 531             {
 532               VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
 533             }
 534         got_it:
 535
 536           /* Now, say which argument to start evaluating from */
 537           tem = 2;
 538         }
 539       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 540         {
 541           /* Hair for method invocations */
 542           int tem2;
 543
 544           nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
 545           /* First, evaluate the structure into arg2 */
 546           pc2 = (*pos)++;
 547           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
 548           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
 549           if (noside == EVAL_SKIP)
 550             goto nosideret;
 551
 552           if (op == STRUCTOP_STRUCT)
 553             {
 554               /* If v is a variable in a register, and the user types
 555                  v.method (), this will produce an error, because v has
 556                  no address.
 557
 558                  A possible way around this would be to allocate a
 559                  copy of the variable on the stack, copy in the
 560                  contents, call the function, and copy out the
 561                  contents.  I.e. convert this from call by reference
 562                  to call by copy-return (or whatever it's called).
 563                  However, this does not work because it is not the
 564                  same: the method being called could stash a copy of
 565                  the address, and then future uses through that address
 566                  (after the method returns) would be expected to
 567                  use the variable itself, not some copy of it.  */
 568               arg2 = evaluate_subexp_for_address (exp, pos, noside);
 569             }
 570           else
 571             {
 572               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 573             }
 574           /* Now, say which argument to start evaluating from */
 575           tem = 2;
 576         }
 577       else
 578         {
 579           nargs = longest_to_int (exp->elts[pc + 1].longconst);
 580           tem = 0;
 581         }
 582       /* Allocate arg vector, including space for the function to be
 583          called in argvec[0] and a terminating NULL */
 584       argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 585       for (; tem <= nargs; tem++)
 586         /* Ensure that array expressions are coerced into pointer objects. */
 587         argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 588
 589       /* signal end of arglist */
 590       argvec[tem] = 0;
 591
 592       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
 593         {
 594           int static_memfuncp;
 595           value_ptr temp = arg2;
 596           char tstr[64];
 597
 598           argvec[1] = arg2;
 599           argvec[0] = 0;
 600           strcpy(tstr, &exp->elts[pc2+2].string);
 601           if (!argvec[0])
 602             {
 603               temp = arg2;
 604               argvec[0] =
 605               value_struct_elt (&temp, argvec+1, tstr,
 606                               &static_memfuncp,
 607                               op == STRUCTOP_STRUCT
 608                               ? "structure" : "structure pointer");
 609             }
 610           arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
 611                          VALUE_ADDRESS (temp)+VALUE_OFFSET (temp));
 612           argvec[1] = arg2;
 613
 614           if (static_memfuncp)
 615             {
 616               argvec[1] = argvec[0];
 617               nargs--;
 618               argvec++;
 619             }
 620         }
 621       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 622         {
 623           argvec[1] = arg2;
 624           argvec[0] = arg1;
 625         }
 626
 627     do_call_it:
 628
 629       if (noside == EVAL_SKIP)
 630         goto nosideret;
 631       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 632         {
 633           /* If the return type doesn't look like a function type, call an
 634              error.  This can happen if somebody tries to turn a variable into
 635              a function call. This is here because people often want to
 636              call, eg, strcmp, which gdb doesn't know is a function.  If
 637              gdb isn't asked for it's opinion (ie. through "whatis"),
 638              it won't offer it. */
 639
 640           struct type *ftype =
 641             TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
 642
 643           if (ftype)
 644             return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
 645           else
 646             error ("Expression of type other than \"Function returning ...\" used as function");
 647         }
 648       return call_function_by_hand (argvec[0], nargs, argvec + 1);
 649
 650     case OP_F77_UNDETERMINED_ARGLIST:
 651
 652       /* Remember that in F77, functions, substring ops and
 653          array subscript operations cannot be disambiguated
 654          at parse time.  We have made all array subscript operations,
 655          substring operations as well as function calls  come here
 656          and we now have to discover what the heck this thing actually was.
 657          If it is an array, we massage it into a form that the
 658          MULTI_F77_SUBSCRIPT operator can deal with. If it is
 659          a function, we process just as if we got an OP_FUNCALL and
 660          for a subscring operation, we perform the appropriate
 661          substring operation.  */
 662
 663       /* First get the nargs and then jump all the way over the:
 664
 665          OP_UNDETERMINED_ARGLIST
 666          nargs
 667          OP_UNDETERMINED_ARGLIST
 668
 669          instruction sequence */
 670
 671       nargs = longest_to_int (exp->elts[pc+1].longconst);
 672       (*pos) += 2;
 673
 674       /* First determine the type code we are dealing with.  */
 675       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 676       code = TYPE_CODE (VALUE_TYPE (arg1));
 677
 678       switch (code)
 679         {
 680         case TYPE_CODE_ARRAY:
 681           goto multi_f77_subscript;
 682
 683         case TYPE_CODE_STRING:
 684           goto op_f77_substr;
 685
 686         case TYPE_CODE_PTR:
 687         case TYPE_CODE_FUNC:
 688           /* It's a function call. */
 689           /* Allocate arg vector, including space for the function to be
 690              called in argvec[0] and a terminating NULL */
 691           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 692           argvec[0] = arg1;
 693           tem = 1;
 694           for (; tem <= nargs; tem++)
 695             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 696           argvec[tem] = 0; /* signal end of arglist */
 697           goto do_call_it;
 698
 699         default:
 700               error ("Cannot perform substring on this type");
 701         }
 702
 703     op_f77_substr:
 704       /* We have a substring operation on our hands here,
 705          let us get the string we will be dealing with */
 706
 707       /* Now evaluate the 'from' and 'to' */
 708
 709       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 710
 711       if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
 712          error ("Substring arguments must be of type integer");
 713
 714       if (nargs < 2)
 715         return value_subscript (arg1, arg2);
 716
 717       arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
 718
 719       if (TYPE_CODE (VALUE_TYPE (arg3)) != TYPE_CODE_INT)
 720          error ("Substring arguments must be of type integer");
 721
 722       tem2 = *((int *) VALUE_CONTENTS_RAW (arg2));
 723       tem3 = *((int *) VALUE_CONTENTS_RAW (arg3));
 724
 725       if ((tem2 < 1) || (tem2 > tem3))
 726          error ("Bad 'from' value %d on substring operation", tem2);
 727
 728       if ((tem3 < tem2) || (tem3 > (TYPE_LENGTH (VALUE_TYPE (arg1)))))
 729          error ("Bad 'to' value %d on substring operation", tem3);
 730
 731       if (noside == EVAL_SKIP)
 732         goto nosideret;
 733
 734       return value_slice (arg1, tem2, tem3 - tem2 + 1);
 735
 736     case OP_COMPLEX:
 737       /* We have a complex number, There should be 2 floating
 738          point numbers that compose it */
 739       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 740       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 741
 742       return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
 743
 744     case STRUCTOP_STRUCT:
 745       tem = longest_to_int (exp->elts[pc + 1].longconst);
 746       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 747       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 748       if (noside == EVAL_SKIP)
 749         goto nosideret;
 750       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 751         return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
 752                                                    &exp->elts[pc + 2].string,
 753                                                    0),
 754                            lval_memory);
 755       else
 756         {
 757           value_ptr temp = arg1;
 758           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
 759                                    NULL, "structure");
 760         }
 761
 762     case STRUCTOP_PTR:
 763       tem = longest_to_int (exp->elts[pc + 1].longconst);
 764       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 765       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 766       if (noside == EVAL_SKIP)
 767         goto nosideret;
 768       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 769         return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
 770                                                    &exp->elts[pc + 2].string,
 771                                                    0),
 772                            lval_memory);
 773       else
 774         {
 775           value_ptr temp = arg1;
 776           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
 777                                    NULL, "structure pointer");
 778         }
 779
 780     case STRUCTOP_MEMBER:
 781       arg1 = evaluate_subexp_for_address (exp, pos, noside);
 782       goto handle_pointer_to_member;
 783     case STRUCTOP_MPTR:
 784       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 785     handle_pointer_to_member:
 786       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 787       if (noside == EVAL_SKIP)
 788         goto nosideret;
 789       if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_PTR)
 790         goto bad_pointer_to_member;
 791       type = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
 792       if (TYPE_CODE (type) == TYPE_CODE_METHOD)
 793         error ("not implemented: pointer-to-method in pointer-to-member construct");
 794       if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
 795         goto bad_pointer_to_member;
 796       /* Now, convert these values to an address.  */
 797       arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
 798                          arg1);
 799       arg3 = value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
 800                                  value_as_long (arg1) + value_as_long (arg2));
 801       return value_ind (arg3);
 802     bad_pointer_to_member:
 803       error("non-pointer-to-member value used in pointer-to-member construct");
 804
 805     case BINOP_CONCAT:
 806       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 807       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 808       if (noside == EVAL_SKIP)
 809         goto nosideret;
 810       if (binop_user_defined_p (op, arg1, arg2))
 811         return value_x_binop (arg1, arg2, op, OP_NULL);
 812       else
 813         return value_concat (arg1, arg2);
 814
 815     case BINOP_ASSIGN:
 816       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 817       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
 818       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 819         return arg1;
 820       if (binop_user_defined_p (op, arg1, arg2))
 821         return value_x_binop (arg1, arg2, op, OP_NULL);
 822       else
 823         return value_assign (arg1, arg2);
 824
 825     case BINOP_ASSIGN_MODIFY:
 826       (*pos) += 2;
 827       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 828       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
 829       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 830         return arg1;
 831       op = exp->elts[pc + 1].opcode;
 832       if (binop_user_defined_p (op, arg1, arg2))
 833         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op);
 834       else if (op == BINOP_ADD)
 835         arg2 = value_add (arg1, arg2);
 836       else if (op == BINOP_SUB)
 837         arg2 = value_sub (arg1, arg2);
 838       else
 839         arg2 = value_binop (arg1, arg2, op);
 840       return value_assign (arg1, arg2);
 841
 842     case BINOP_ADD:
 843       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 844       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 845       if (noside == EVAL_SKIP)
 846         goto nosideret;
 847       if (binop_user_defined_p (op, arg1, arg2))
 848         return value_x_binop (arg1, arg2, op, OP_NULL);
 849       else
 850         return value_add (arg1, arg2);
 851
 852     case BINOP_SUB:
 853       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 854       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 855       if (noside == EVAL_SKIP)
 856         goto nosideret;
 857       if (binop_user_defined_p (op, arg1, arg2))
 858         return value_x_binop (arg1, arg2, op, OP_NULL);
 859       else
 860         return value_sub (arg1, arg2);
 861
 862     case BINOP_MUL:
 863     case BINOP_DIV:
 864     case BINOP_REM:
 865     case BINOP_MOD:
 866     case BINOP_LSH:
 867     case BINOP_RSH:
 868     case BINOP_BITWISE_AND:
 869     case BINOP_BITWISE_IOR:
 870     case BINOP_BITWISE_XOR:
 871       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 872       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 873       if (noside == EVAL_SKIP)
 874         goto nosideret;
 875       if (binop_user_defined_p (op, arg1, arg2))
 876         return value_x_binop (arg1, arg2, op, OP_NULL);
 877       else
 878         if (noside == EVAL_AVOID_SIDE_EFFECTS
 879             && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
 880           return value_zero (VALUE_TYPE (arg1), not_lval);
 881       else
 882         return value_binop (arg1, arg2, op);
 883
 884     case BINOP_SUBSCRIPT:
 885       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 886       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 887       if (noside == EVAL_SKIP)
 888         goto nosideret;
 889       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 890         {
 891           /* If the user attempts to subscript something that has no target
 892              type (like a plain int variable for example), then report this
 893              as an error. */
 894
 895           type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
 896           if (type)
 897             return value_zero (type, VALUE_LVAL (arg1));
 898           else
 899             error ("cannot subscript something of type `%s'",
 900                    TYPE_NAME (VALUE_TYPE (arg1)));
 901         }
 902
 903       if (binop_user_defined_p (op, arg1, arg2))
 904         return value_x_binop (arg1, arg2, op, OP_NULL);
 905       else
 906         return value_subscript (arg1, arg2);
 907
 908     case BINOP_IN:
 909       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 910       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 911       if (noside == EVAL_SKIP)
 912         goto nosideret;
 913       return value_in (arg1, arg2);
 914
 915     case MULTI_SUBSCRIPT:
 916       (*pos) += 2;
 917       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 918       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 919       while (nargs-- > 0)
 920         {
 921           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 922           /* FIXME:  EVAL_SKIP handling may not be correct. */
 923           if (noside == EVAL_SKIP)
 924             {
 925               if (nargs > 0)
 926                 {
 927                   continue;
 928                 }
 929               else
 930                 {
 931                   goto nosideret;
 932                 }
 933             }
 934           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
 935           if (noside == EVAL_AVOID_SIDE_EFFECTS)
 936             {
 937               /* If the user attempts to subscript something that has no target
 938                  type (like a plain int variable for example), then report this
 939                  as an error. */
 940
 941               type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
 942               if (type != NULL)
 943                 {
 944                   arg1 = value_zero (type, VALUE_LVAL (arg1));
 945                   noside = EVAL_SKIP;
 946                   continue;
 947                 }
 948               else
 949                 {
 950                   error ("cannot subscript something of type `%s'",
 951                          TYPE_NAME (VALUE_TYPE (arg1)));
 952                 }
 953             }
 954
 955           if (binop_user_defined_p (op, arg1, arg2)
 956               && ! chill_varying_type (VALUE_TYPE (arg1)))
 957             {
 958               arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
 959             }
 960           else
 961             {
 962               arg1 = value_subscript (arg1, arg2);
 963             }
 964         }
 965       return (arg1);
 966
 967     multi_f77_subscript:
 968       {
 969         int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of
 970                                                     subscripts, max == 7 */
 971         int array_size_array[MAX_FORTRAN_DIMS+1];
 972         int ndimensions=1,i;
 973         struct type *tmp_type;
 974         int offset_item;   /* The array offset where the item lives */
 975         int fixed_subscript;
 976
 977         if (nargs > MAX_FORTRAN_DIMS)
 978           error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
 979
 980         ndimensions = calc_f77_array_dims (VALUE_TYPE (arg1));
 981
 982         if (nargs != ndimensions)
 983           error ("Wrong number of subscripts");
 984
 985         /* Now that we know we have a legal array subscript expression
 986            let us actually find out where this element exists in the array. */
 987
 988         tmp_type = VALUE_TYPE (arg1);
 989         offset_item = 0;
 990         for (i = 1; i <= nargs; i++)
 991           {
 992             /* Evaluate each subscript, It must be a legal integer in F77 */
 993             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 994
 995             if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
 996               error ("Array subscripts must be of type integer");
 997
 998             /* Fill in the subscript and array size arrays */
 999
1000             subscript_array[i] = (* (unsigned int *) VALUE_CONTENTS(arg2));
1001
1002             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1003             if (retcode == BOUND_FETCH_ERROR)
1004               error ("Cannot obtain dynamic upper bound");
1005
1006             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1007             if (retcode == BOUND_FETCH_ERROR)
1008               error("Cannot obtain dynamic lower bound");
1009
1010             array_size_array[i] = upper - lower + 1;
1011
1012             /* Zero-normalize subscripts so that offsetting will work. */
1013
1014             subscript_array[i] -= lower;
1015
1016             /* If we are at the bottom of a multidimensional
1017                array type then keep a ptr to the last ARRAY
1018                type around for use when calling value_subscript()
1019                below. This is done because we pretend to value_subscript
1020                that we actually have a one-dimensional array
1021                of base element type that we apply a simple
1022                offset to. */
1023
1024             if (i < nargs)
1025               tmp_type = TYPE_TARGET_TYPE (tmp_type);
1026           }
1027
1028         /* Now let us calculate the offset for this item */
1029
1030         offset_item = subscript_array[ndimensions];
1031
1032         for (i = ndimensions - 1; i >= 1; i--)
1033           offset_item =
1034             array_size_array[i] * offset_item + subscript_array[i];
1035
1036         /* Construct a value node with the value of the offset */
1037
1038         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1039
1040         /* Let us now play a dirty trick: we will take arg1
1041            which is a value node pointing to the topmost level
1042            of the multidimensional array-set and pretend
1043            that it is actually a array of the final element
1044            type, this will ensure that value_subscript()
1045            returns the correct type value */
1046
1047         VALUE_TYPE (arg1) = tmp_type;
1048
1049         arg1 = value_subscript (arg1, arg2);
1050         return arg1;
1051       }
1052
1053     case BINOP_LOGICAL_AND:
1054       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1055       if (noside == EVAL_SKIP)
1056         {
1057           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1058           goto nosideret;
1059         }
1060
1061       oldpos = *pos;
1062       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1063       *pos = oldpos;
1064
1065       if (binop_user_defined_p (op, arg1, arg2))
1066         {
1067           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1068           return value_x_binop (arg1, arg2, op, OP_NULL);
1069         }
1070       else
1071         {
1072           tem = value_logical_not (arg1);
1073           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1074                                   (tem ? EVAL_SKIP : noside));
1075           return value_from_longest (builtin_type_int,
1076                                   (LONGEST) (!tem && !value_logical_not (arg2)));
1077         }
1078
1079     case BINOP_LOGICAL_OR:
1080       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1081       if (noside == EVAL_SKIP)
1082         {
1083           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1084           goto nosideret;
1085         }
1086
1087       oldpos = *pos;
1088       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1089       *pos = oldpos;
1090
1091       if (binop_user_defined_p (op, arg1, arg2))
1092         {
1093           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1094           return value_x_binop (arg1, arg2, op, OP_NULL);
1095         }
1096       else
1097         {
1098           tem = value_logical_not (arg1);
1099           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1100                                   (!tem ? EVAL_SKIP : noside));
1101           return value_from_longest (builtin_type_int,
1102                                   (LONGEST) (!tem || !value_logical_not (arg2)));
1103         }
1104
1105     case BINOP_EQUAL:
1106       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1107       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1108       if (noside == EVAL_SKIP)
1109         goto nosideret;
1110       if (binop_user_defined_p (op, arg1, arg2))
1111         {
1112           return value_x_binop (arg1, arg2, op, OP_NULL);
1113         }
1114       else
1115         {
1116           tem = value_equal (arg1, arg2);
1117           return value_from_longest (builtin_type_int, (LONGEST) tem);
1118         }
1119
1120     case BINOP_NOTEQUAL:
1121       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1122       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1123       if (noside == EVAL_SKIP)
1124         goto nosideret;
1125       if (binop_user_defined_p (op, arg1, arg2))
1126         {
1127           return value_x_binop (arg1, arg2, op, OP_NULL);
1128         }
1129       else
1130         {
1131           tem = value_equal (arg1, arg2);
1132           return value_from_longest (builtin_type_int, (LONGEST) ! tem);
1133         }
1134
1135     case BINOP_LESS:
1136       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1137       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1138       if (noside == EVAL_SKIP)
1139         goto nosideret;
1140       if (binop_user_defined_p (op, arg1, arg2))
1141         {
1142           return value_x_binop (arg1, arg2, op, OP_NULL);
1143         }
1144       else
1145         {
1146           tem = value_less (arg1, arg2);
1147           return value_from_longest (builtin_type_int, (LONGEST) tem);
1148         }
1149
1150     case BINOP_GTR:
1151       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1152       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1153       if (noside == EVAL_SKIP)
1154         goto nosideret;
1155       if (binop_user_defined_p (op, arg1, arg2))
1156         {
1157           return value_x_binop (arg1, arg2, op, OP_NULL);
1158         }
1159       else
1160         {
1161           tem = value_less (arg2, arg1);
1162           return value_from_longest (builtin_type_int, (LONGEST) tem);
1163         }
1164
1165     case BINOP_GEQ:
1166       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1167       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1168       if (noside == EVAL_SKIP)
1169         goto nosideret;
1170       if (binop_user_defined_p (op, arg1, arg2))
1171         {
1172           return value_x_binop (arg1, arg2, op, OP_NULL);
1173         }
1174       else
1175         {
1176           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1177           return value_from_longest (builtin_type_int, (LONGEST) tem);
1178         }
1179
1180     case BINOP_LEQ:
1181       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1182       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1183       if (noside == EVAL_SKIP)
1184         goto nosideret;
1185       if (binop_user_defined_p (op, arg1, arg2))
1186         {
1187           return value_x_binop (arg1, arg2, op, OP_NULL);
1188         }
1189       else
1190         {
1191           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1192           return value_from_longest (builtin_type_int, (LONGEST) tem);
1193         }
1194
1195     case BINOP_REPEAT:
1196       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1197       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1198       if (noside == EVAL_SKIP)
1199         goto nosideret;
1200       if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
1201         error ("Non-integral right operand for \"@\" operator.");
1202       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1203         return allocate_repeat_value (VALUE_TYPE (arg1),
1204                                       longest_to_int (value_as_long (arg2)));
1205       else
1206         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1207
1208     case BINOP_COMMA:
1209       evaluate_subexp (NULL_TYPE, exp, pos, noside);
1210       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1211
1212     case UNOP_NEG:
1213       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1214       if (noside == EVAL_SKIP)
1215         goto nosideret;
1216       if (unop_user_defined_p (op, arg1))
1217         return value_x_unop (arg1, op);
1218       else
1219         return value_neg (arg1);
1220
1221     case UNOP_COMPLEMENT:
1222       /* C++: check for and handle destructor names.  */
1223       op = exp->elts[*pos].opcode;
1224
1225       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1226       if (noside == EVAL_SKIP)
1227         goto nosideret;
1228       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1229         return value_x_unop (arg1, UNOP_COMPLEMENT);
1230       else
1231         return value_complement (arg1);
1232
1233     case UNOP_LOGICAL_NOT:
1234       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1235       if (noside == EVAL_SKIP)
1236         goto nosideret;
1237       if (unop_user_defined_p (op, arg1))
1238         return value_x_unop (arg1, op);
1239       else
1240         return value_from_longest (builtin_type_int,
1241                                    (LONGEST) value_logical_not (arg1));
1242
1243     case UNOP_IND:
1244       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1245         expect_type = TYPE_TARGET_TYPE (expect_type);
1246       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1247       if (noside == EVAL_SKIP)
1248         goto nosideret;
1249       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1250         {
1251           if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR
1252               || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_REF
1253               /* In C you can dereference an array to get the 1st elt.  */
1254               || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY
1255               )
1256             return value_zero (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)),
1257                                lval_memory);
1258           else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_INT)
1259             /* GDB allows dereferencing an int.  */
1260             return value_zero (builtin_type_int, lval_memory);
1261           else
1262             error ("Attempt to take contents of a non-pointer value.");
1263         }
1264       return value_ind (arg1);
1265
1266     case UNOP_ADDR:
1267       /* C++: check for and handle pointer to members.  */
1268
1269       op = exp->elts[*pos].opcode;
1270
1271       if (noside == EVAL_SKIP)
1272         {
1273           if (op == OP_SCOPE)
1274             {
1275               int temm = longest_to_int (exp->elts[pc+3].longconst);
1276               (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1277             }
1278           else
1279             evaluate_subexp (expect_type, exp, pos, EVAL_SKIP);
1280           goto nosideret;
1281         }
1282
1283       return evaluate_subexp_for_address (exp, pos, noside);
1284
1285     case UNOP_SIZEOF:
1286       if (noside == EVAL_SKIP)
1287         {
1288           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1289           goto nosideret;
1290         }
1291       return evaluate_subexp_for_sizeof (exp, pos);
1292
1293     case UNOP_CAST:
1294       (*pos) += 2;
1295       type = exp->elts[pc + 1].type;
1296       arg1 = evaluate_subexp (type, exp, pos, noside);
1297       if (noside == EVAL_SKIP)
1298         goto nosideret;
1299       if (type != VALUE_TYPE (arg1))
1300         arg1 = value_cast (type, arg1);
1301       return arg1;
1302
1303     case UNOP_MEMVAL:
1304       (*pos) += 2;
1305       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1306       if (noside == EVAL_SKIP)
1307         goto nosideret;
1308       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1309         return value_zero (exp->elts[pc + 1].type, lval_memory);
1310       else
1311         return value_at_lazy (exp->elts[pc + 1].type,
1312                               value_as_pointer (arg1));
1313
1314     case UNOP_PREINCREMENT:
1315       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1316       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1317         return arg1;
1318       else if (unop_user_defined_p (op, arg1))
1319         {
1320           return value_x_unop (arg1, op);
1321         }
1322       else
1323         {
1324           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1325                                                    (LONGEST) 1));
1326           return value_assign (arg1, arg2);
1327         }
1328
1329     case UNOP_PREDECREMENT:
1330       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1331       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1332         return arg1;
1333       else if (unop_user_defined_p (op, arg1))
1334         {
1335           return value_x_unop (arg1, op);
1336         }
1337       else
1338         {
1339           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1340                                                    (LONGEST) 1));
1341           return value_assign (arg1, arg2);
1342         }
1343
1344     case UNOP_POSTINCREMENT:
1345       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1346       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1347         return arg1;
1348       else if (unop_user_defined_p (op, arg1))
1349         {
1350           return value_x_unop (arg1, op);
1351         }
1352       else
1353         {
1354           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1355                                                    (LONGEST) 1));
1356           value_assign (arg1, arg2);
1357           return arg1;
1358         }
1359
1360     case UNOP_POSTDECREMENT:
1361       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1362       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1363         return arg1;
1364       else if (unop_user_defined_p (op, arg1))
1365         {
1366           return value_x_unop (arg1, op);
1367         }
1368       else
1369         {
1370           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1371                                                    (LONGEST) 1));
1372           value_assign (arg1, arg2);
1373           return arg1;
1374         }
1375
1376     case OP_THIS:
1377       (*pos) += 1;
1378       return value_of_this (1);
1379
1380     case OP_TYPE:
1381       error ("Attempt to use a type name as an expression");
1382
1383     default:
1384       /* Removing this case and compiling with gcc -Wall reveals that
1385          a lot of cases are hitting this case.  Some of these should
1386          probably be removed from expression.h (e.g. do we need a BINOP_SCOPE
1387          and an OP_SCOPE?); others are legitimate expressions which are
1388          (apparently) not fully implemented.
1389
1390          If there are any cases landing here which mean a user error,
1391          then they should be separate cases, with more descriptive
1392          error messages.  */
1393
1394       error ("\
1395 GDB does not (yet) know how to evaluate that kind of expression");
1396     }
1397
1398  nosideret:
1399   return value_from_longest (builtin_type_long, (LONGEST) 1);
1400 }
1401 \f
1402 /* Evaluate a subexpression of EXP, at index *POS,
1403    and return the address of that subexpression.
1404    Advance *POS over the subexpression.
1405    If the subexpression isn't an lvalue, get an error.
1406    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
1407    then only the type of the result need be correct.  */
1408
1409 static value_ptr
1410 evaluate_subexp_for_address (exp, pos, noside)
1411      register struct expression *exp;
1412      register int *pos;
1413      enum noside noside;
1414 {
1415   enum exp_opcode op;
1416   register int pc;
1417   struct symbol *var;
1418
1419   pc = (*pos);
1420   op = exp->elts[pc].opcode;
1421
1422   switch (op)
1423     {
1424     case UNOP_IND:
1425       (*pos)++;
1426       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1427
1428     case UNOP_MEMVAL:
1429       (*pos) += 3;
1430       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
1431                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
1432
1433     case OP_VAR_VALUE:
1434       var = exp->elts[pc + 2].symbol;
1435
1436       /* C++: The "address" of a reference should yield the address
1437        * of the object pointed to. Let value_addr() deal with it. */
1438       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
1439         goto default_case;
1440
1441       (*pos) += 4;
1442       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1443         {
1444           struct type *type =
1445             lookup_pointer_type (SYMBOL_TYPE (var));
1446           enum address_class sym_class = SYMBOL_CLASS (var);
1447
1448           if (sym_class == LOC_CONST
1449               || sym_class == LOC_CONST_BYTES
1450               || sym_class == LOC_REGISTER
1451               || sym_class == LOC_REGPARM)
1452             error ("Attempt to take address of register or constant.");
1453
1454         return
1455           value_zero (type, not_lval);
1456         }
1457       else
1458         return
1459           locate_var_value
1460             (var,
1461              block_innermost_frame (exp->elts[pc + 1].block));
1462
1463     default:
1464     default_case:
1465       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1466         {
1467           value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1468           if (VALUE_LVAL (x) == lval_memory)
1469             return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
1470                                not_lval);
1471           else
1472             error ("Attempt to take address of non-lval");
1473         }
1474       return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1475     }
1476 }
1477
1478 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
1479    When used in contexts where arrays will be coerced anyway, this is
1480    equivalent to `evaluate_subexp' but much faster because it avoids
1481    actually fetching array contents (perhaps obsolete now that we have
1482    VALUE_LAZY).
1483
1484    Note that we currently only do the coercion for C expressions, where
1485    arrays are zero based and the coercion is correct.  For other languages,
1486    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
1487    to decide if coercion is appropriate.
1488
1489    */
1490
1491 static value_ptr
1492 evaluate_subexp_with_coercion (exp, pos, noside)
1493      register struct expression *exp;
1494      register int *pos;
1495      enum noside noside;
1496 {
1497   register enum exp_opcode op;
1498   register int pc;
1499   register value_ptr val;
1500   struct symbol *var;
1501
1502   pc = (*pos);
1503   op = exp->elts[pc].opcode;
1504
1505   switch (op)
1506     {
1507     case OP_VAR_VALUE:
1508       var = exp->elts[pc + 2].symbol;
1509       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ARRAY
1510           && CAST_IS_CONVERSION)
1511         {
1512           (*pos) += 4;
1513           val =
1514             locate_var_value
1515               (var, block_innermost_frame (exp->elts[pc + 1].block));
1516           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (SYMBOL_TYPE (var))),
1517                              val);
1518         }
1519       /* FALLTHROUGH */
1520
1521     default:
1522       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1523     }
1524 }
1525
1526 /* Evaluate a subexpression of EXP, at index *POS,
1527    and return a value for the size of that subexpression.
1528    Advance *POS over the subexpression.  */
1529
1530 static value_ptr
1531 evaluate_subexp_for_sizeof (exp, pos)
1532      register struct expression *exp;
1533      register int *pos;
1534 {
1535   enum exp_opcode op;
1536   register int pc;
1537   value_ptr val;
1538
1539   pc = (*pos);
1540   op = exp->elts[pc].opcode;
1541
1542   switch (op)
1543     {
1544       /* This case is handled specially
1545          so that we avoid creating a value for the result type.
1546          If the result type is very big, it's desirable not to
1547          create a value unnecessarily.  */
1548     case UNOP_IND:
1549       (*pos)++;
1550       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1551       return value_from_longest (builtin_type_int, (LONGEST)
1552                       TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (val))));
1553
1554     case UNOP_MEMVAL:
1555       (*pos) += 3;
1556       return value_from_longest (builtin_type_int,
1557                               (LONGEST) TYPE_LENGTH (exp->elts[pc + 1].type));
1558
1559     case OP_VAR_VALUE:
1560       (*pos) += 4;
1561       return
1562         value_from_longest
1563           (builtin_type_int,
1564            (LONGEST) TYPE_LENGTH (SYMBOL_TYPE (exp->elts[pc + 2].symbol)));
1565
1566     default:
1567       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1568       return value_from_longest (builtin_type_int,
1569                               (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
1570     }
1571 }
1572
1573 /* Parse a type expression in the string [P..P+LENGTH). */
1574
1575 struct type *
1576 parse_and_eval_type (p, length)
1577      char *p;
1578      int length;
1579 {
1580     char *tmp = (char *)alloca (length + 4);
1581     struct expression *expr;
1582     tmp[0] = '(';
1583     memcpy (tmp+1, p, length);
1584     tmp[length+1] = ')';
1585     tmp[length+2] = '0';
1586     tmp[length+3] = '\0';
1587     expr = parse_expression (tmp);
1588     if (expr->elts[0].opcode != UNOP_CAST)
1589         error ("Internal error in eval_type.");
1590     return expr->elts[1].type;
1591 }
1592
1593 int
1594 calc_f77_array_dims (array_type)
1595      struct type *array_type;
1596 {
1597   int ndimen = 1;
1598   struct type *tmp_type;
1599
1600   if ((TYPE_CODE(array_type) != TYPE_CODE_ARRAY))
1601     error ("Can't get dimensions for a non-array type");
1602
1603   tmp_type = array_type;
1604
1605   while (tmp_type = TYPE_TARGET_TYPE (tmp_type))
1606     {
1607       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
1608         ++ndimen;
1609     }
1610   return ndimen;
1611 }