OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.0/] [gdb/] [eval.c] - Diff between revs 105 and 1765

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 105 Rev 1765
/* Evaluate expressions for GDB.
/* Evaluate expressions for GDB.
   Copyright 1986, 87, 89, 91, 92, 93, 94, 95, 96, 97, 1998
   Copyright 1986, 87, 89, 91, 92, 93, 94, 95, 96, 97, 1998
   Free Software Foundation, Inc.
   Free Software Foundation, Inc.
 
 
   This file is part of GDB.
   This file is part of GDB.
 
 
   This program is free software; you can redistribute it and/or modify
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.
   (at your option) any later version.
 
 
   This program is distributed in the hope that it will be useful,
   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
   GNU General Public License for more details.
 
 
   You should have received a copy of the GNU General Public License
   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place - Suite 330,
   Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  */
   Boston, MA 02111-1307, USA.  */
 
 
#include "defs.h"
#include "defs.h"
#include "gdb_string.h"
#include "gdb_string.h"
#include "symtab.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "gdbtypes.h"
#include "value.h"
#include "value.h"
#include "expression.h"
#include "expression.h"
#include "target.h"
#include "target.h"
#include "frame.h"
#include "frame.h"
#include "demangle.h"
#include "demangle.h"
#include "language.h"           /* For CAST_IS_CONVERSION */
#include "language.h"           /* For CAST_IS_CONVERSION */
#include "f-lang.h"             /* for array bound stuff */
#include "f-lang.h"             /* for array bound stuff */
 
 
/* Defined in symtab.c */
/* Defined in symtab.c */
extern int hp_som_som_object_present;
extern int hp_som_som_object_present;
 
 
/* This is defined in valops.c */
/* This is defined in valops.c */
extern int overload_resolution;
extern int overload_resolution;
 
 
/* JYG: lookup rtti type of STRUCTOP_PTR when this is set to continue
/* JYG: lookup rtti type of STRUCTOP_PTR when this is set to continue
   on with successful lookup for member/method of the rtti type. */
   on with successful lookup for member/method of the rtti type. */
extern int objectprint;
extern int objectprint;
 
 
/* Prototypes for local functions. */
/* Prototypes for local functions. */
 
 
static value_ptr evaluate_subexp_for_sizeof PARAMS ((struct expression *,
static value_ptr evaluate_subexp_for_sizeof PARAMS ((struct expression *,
                                                     int *));
                                                     int *));
 
 
static value_ptr evaluate_subexp_for_address PARAMS ((struct expression *,
static value_ptr evaluate_subexp_for_address PARAMS ((struct expression *,
                                                      int *, enum noside));
                                                      int *, enum noside));
 
 
static value_ptr evaluate_subexp PARAMS ((struct type *, struct expression *,
static value_ptr evaluate_subexp PARAMS ((struct type *, struct expression *,
                                          int *, enum noside));
                                          int *, enum noside));
 
 
static char *get_label PARAMS ((struct expression *, int *));
static char *get_label PARAMS ((struct expression *, int *));
 
 
static value_ptr
static value_ptr
  evaluate_struct_tuple PARAMS ((value_ptr, struct expression *, int *,
  evaluate_struct_tuple PARAMS ((value_ptr, struct expression *, int *,
                                 enum noside, int));
                                 enum noside, int));
 
 
static LONGEST
static LONGEST
  init_array_element PARAMS ((value_ptr, value_ptr, struct expression *,
  init_array_element PARAMS ((value_ptr, value_ptr, struct expression *,
                              int *, enum noside, LONGEST, LONGEST));
                              int *, enum noside, LONGEST, LONGEST));
 
 
#if defined (__GNUC__) && !__STDC__
#if defined (__GNUC__) && !__STDC__
inline
inline
#endif
#endif
static value_ptr
static value_ptr
evaluate_subexp (expect_type, exp, pos, noside)
evaluate_subexp (expect_type, exp, pos, noside)
     struct type *expect_type;
     struct type *expect_type;
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
     enum noside noside;
     enum noside noside;
{
{
  return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
  return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
}
}


/* Parse the string EXP as a C expression, evaluate it,
/* Parse the string EXP as a C expression, evaluate it,
   and return the result as a number.  */
   and return the result as a number.  */
 
 
CORE_ADDR
CORE_ADDR
parse_and_eval_address (exp)
parse_and_eval_address (exp)
     char *exp;
     char *exp;
{
{
  struct expression *expr = parse_expression (exp);
  struct expression *expr = parse_expression (exp);
  register CORE_ADDR addr;
  register CORE_ADDR addr;
  register struct cleanup *old_chain =
  register struct cleanup *old_chain =
  make_cleanup ((make_cleanup_func) free_current_contents, &expr);
  make_cleanup ((make_cleanup_func) free_current_contents, &expr);
 
 
  addr = value_as_pointer (evaluate_expression (expr));
  addr = value_as_pointer (evaluate_expression (expr));
  do_cleanups (old_chain);
  do_cleanups (old_chain);
  return addr;
  return addr;
}
}
 
 
/* Like parse_and_eval_address but takes a pointer to a char * variable
/* Like parse_and_eval_address but takes a pointer to a char * variable
   and advanced that variable across the characters parsed.  */
   and advanced that variable across the characters parsed.  */
 
 
CORE_ADDR
CORE_ADDR
parse_and_eval_address_1 (expptr)
parse_and_eval_address_1 (expptr)
     char **expptr;
     char **expptr;
{
{
  struct expression *expr = parse_exp_1 (expptr, (struct block *) 0, 0);
  struct expression *expr = parse_exp_1 (expptr, (struct block *) 0, 0);
  register CORE_ADDR addr;
  register CORE_ADDR addr;
  register struct cleanup *old_chain =
  register struct cleanup *old_chain =
  make_cleanup ((make_cleanup_func) free_current_contents, &expr);
  make_cleanup ((make_cleanup_func) free_current_contents, &expr);
 
 
  addr = value_as_pointer (evaluate_expression (expr));
  addr = value_as_pointer (evaluate_expression (expr));
  do_cleanups (old_chain);
  do_cleanups (old_chain);
  return addr;
  return addr;
}
}
 
 
value_ptr
value_ptr
parse_and_eval (exp)
parse_and_eval (exp)
     char *exp;
     char *exp;
{
{
  struct expression *expr = parse_expression (exp);
  struct expression *expr = parse_expression (exp);
  register value_ptr val;
  register value_ptr val;
  register struct cleanup *old_chain
  register struct cleanup *old_chain
  = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
  = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
 
 
  val = evaluate_expression (expr);
  val = evaluate_expression (expr);
  do_cleanups (old_chain);
  do_cleanups (old_chain);
  return val;
  return val;
}
}
 
 
/* Parse up to a comma (or to a closeparen)
/* Parse up to a comma (or to a closeparen)
   in the string EXPP as an expression, evaluate it, and return the value.
   in the string EXPP as an expression, evaluate it, and return the value.
   EXPP is advanced to point to the comma.  */
   EXPP is advanced to point to the comma.  */
 
 
value_ptr
value_ptr
parse_to_comma_and_eval (expp)
parse_to_comma_and_eval (expp)
     char **expp;
     char **expp;
{
{
  struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
  struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
  register value_ptr val;
  register value_ptr val;
  register struct cleanup *old_chain
  register struct cleanup *old_chain
  = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
  = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
 
 
  val = evaluate_expression (expr);
  val = evaluate_expression (expr);
  do_cleanups (old_chain);
  do_cleanups (old_chain);
  return val;
  return val;
}
}


/* Evaluate an expression in internal prefix form
/* Evaluate an expression in internal prefix form
   such as is constructed by parse.y.
   such as is constructed by parse.y.
 
 
   See expression.h for info on the format of an expression.  */
   See expression.h for info on the format of an expression.  */
 
 
value_ptr
value_ptr
evaluate_expression (exp)
evaluate_expression (exp)
     struct expression *exp;
     struct expression *exp;
{
{
  int pc = 0;
  int pc = 0;
  return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
  return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
}
}
 
 
/* Evaluate an expression, avoiding all memory references
/* Evaluate an expression, avoiding all memory references
   and getting a value whose type alone is correct.  */
   and getting a value whose type alone is correct.  */
 
 
value_ptr
value_ptr
evaluate_type (exp)
evaluate_type (exp)
     struct expression *exp;
     struct expression *exp;
{
{
  int pc = 0;
  int pc = 0;
  return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
  return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
}
}
 
 
/* If the next expression is an OP_LABELED, skips past it,
/* If the next expression is an OP_LABELED, skips past it,
   returning the label.  Otherwise, does nothing and returns NULL. */
   returning the label.  Otherwise, does nothing and returns NULL. */
 
 
static char *
static char *
get_label (exp, pos)
get_label (exp, pos)
     register struct expression *exp;
     register struct expression *exp;
     int *pos;
     int *pos;
{
{
  if (exp->elts[*pos].opcode == OP_LABELED)
  if (exp->elts[*pos].opcode == OP_LABELED)
    {
    {
      int pc = (*pos)++;
      int pc = (*pos)++;
      char *name = &exp->elts[pc + 2].string;
      char *name = &exp->elts[pc + 2].string;
      int tem = longest_to_int (exp->elts[pc + 1].longconst);
      int tem = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      return name;
      return name;
    }
    }
  else
  else
    return NULL;
    return NULL;
}
}
 
 
/* This function evaluates tupes (in Chill) or brace-initializers
/* This function evaluates tupes (in Chill) or brace-initializers
   (in C/C++) for structure types.  */
   (in C/C++) for structure types.  */
 
 
static value_ptr
static value_ptr
evaluate_struct_tuple (struct_val, exp, pos, noside, nargs)
evaluate_struct_tuple (struct_val, exp, pos, noside, nargs)
     value_ptr struct_val;
     value_ptr struct_val;
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
     enum noside noside;
     enum noside noside;
     int nargs;
     int nargs;
{
{
  struct type *struct_type = check_typedef (VALUE_TYPE (struct_val));
  struct type *struct_type = check_typedef (VALUE_TYPE (struct_val));
  struct type *substruct_type = struct_type;
  struct type *substruct_type = struct_type;
  struct type *field_type;
  struct type *field_type;
  int fieldno = -1;
  int fieldno = -1;
  int variantno = -1;
  int variantno = -1;
  int subfieldno = -1;
  int subfieldno = -1;
  while (--nargs >= 0)
  while (--nargs >= 0)
    {
    {
      int pc = *pos;
      int pc = *pos;
      value_ptr val = NULL;
      value_ptr val = NULL;
      int nlabels = 0;
      int nlabels = 0;
      int bitpos, bitsize;
      int bitpos, bitsize;
      char *addr;
      char *addr;
 
 
      /* Skip past the labels, and count them. */
      /* Skip past the labels, and count them. */
      while (get_label (exp, pos) != NULL)
      while (get_label (exp, pos) != NULL)
        nlabels++;
        nlabels++;
 
 
      do
      do
        {
        {
          char *label = get_label (exp, &pc);
          char *label = get_label (exp, &pc);
          if (label)
          if (label)
            {
            {
              for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
              for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
                   fieldno++)
                   fieldno++)
                {
                {
                  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
                  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
                  if (field_name != NULL && STREQ (field_name, label))
                  if (field_name != NULL && STREQ (field_name, label))
                    {
                    {
                      variantno = -1;
                      variantno = -1;
                      subfieldno = fieldno;
                      subfieldno = fieldno;
                      substruct_type = struct_type;
                      substruct_type = struct_type;
                      goto found;
                      goto found;
                    }
                    }
                }
                }
              for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
              for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
                   fieldno++)
                   fieldno++)
                {
                {
                  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
                  char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
                  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
                  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
                  if ((field_name == 0 || *field_name == '\0')
                  if ((field_name == 0 || *field_name == '\0')
                      && TYPE_CODE (field_type) == TYPE_CODE_UNION)
                      && TYPE_CODE (field_type) == TYPE_CODE_UNION)
                    {
                    {
                      variantno = 0;
                      variantno = 0;
                      for (; variantno < TYPE_NFIELDS (field_type);
                      for (; variantno < TYPE_NFIELDS (field_type);
                           variantno++)
                           variantno++)
                        {
                        {
                          substruct_type
                          substruct_type
                            = TYPE_FIELD_TYPE (field_type, variantno);
                            = TYPE_FIELD_TYPE (field_type, variantno);
                          if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
                          if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
                            {
                            {
                              for (subfieldno = 0;
                              for (subfieldno = 0;
                                 subfieldno < TYPE_NFIELDS (substruct_type);
                                 subfieldno < TYPE_NFIELDS (substruct_type);
                                   subfieldno++)
                                   subfieldno++)
                                {
                                {
                                  if (STREQ (TYPE_FIELD_NAME (substruct_type,
                                  if (STREQ (TYPE_FIELD_NAME (substruct_type,
                                                              subfieldno),
                                                              subfieldno),
                                             label))
                                             label))
                                    {
                                    {
                                      goto found;
                                      goto found;
                                    }
                                    }
                                }
                                }
                            }
                            }
                        }
                        }
                    }
                    }
                }
                }
              error ("there is no field named %s", label);
              error ("there is no field named %s", label);
            found:
            found:
              ;
              ;
            }
            }
          else
          else
            {
            {
              /* Unlabelled tuple element - go to next field. */
              /* Unlabelled tuple element - go to next field. */
              if (variantno >= 0)
              if (variantno >= 0)
                {
                {
                  subfieldno++;
                  subfieldno++;
                  if (subfieldno >= TYPE_NFIELDS (substruct_type))
                  if (subfieldno >= TYPE_NFIELDS (substruct_type))
                    {
                    {
                      variantno = -1;
                      variantno = -1;
                      substruct_type = struct_type;
                      substruct_type = struct_type;
                    }
                    }
                }
                }
              if (variantno < 0)
              if (variantno < 0)
                {
                {
                  fieldno++;
                  fieldno++;
                  subfieldno = fieldno;
                  subfieldno = fieldno;
                  if (fieldno >= TYPE_NFIELDS (struct_type))
                  if (fieldno >= TYPE_NFIELDS (struct_type))
                    error ("too many initializers");
                    error ("too many initializers");
                  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
                  field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
                  if (TYPE_CODE (field_type) == TYPE_CODE_UNION
                  if (TYPE_CODE (field_type) == TYPE_CODE_UNION
                      && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
                      && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
                    error ("don't know which variant you want to set");
                    error ("don't know which variant you want to set");
                }
                }
            }
            }
 
 
          /* Here, struct_type is the type of the inner struct,
          /* Here, struct_type is the type of the inner struct,
             while substruct_type is the type of the inner struct.
             while substruct_type is the type of the inner struct.
             These are the same for normal structures, but a variant struct
             These are the same for normal structures, but a variant struct
             contains anonymous union fields that contain substruct fields.
             contains anonymous union fields that contain substruct fields.
             The value fieldno is the index of the top-level (normal or
             The value fieldno is the index of the top-level (normal or
             anonymous union) field in struct_field, while the value
             anonymous union) field in struct_field, while the value
             subfieldno is the index of the actual real (named inner) field
             subfieldno is the index of the actual real (named inner) field
             in substruct_type. */
             in substruct_type. */
 
 
          field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
          field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
          if (val == 0)
          if (val == 0)
            val = evaluate_subexp (field_type, exp, pos, noside);
            val = evaluate_subexp (field_type, exp, pos, noside);
 
 
          /* Now actually set the field in struct_val. */
          /* Now actually set the field in struct_val. */
 
 
          /* Assign val to field fieldno. */
          /* Assign val to field fieldno. */
          if (VALUE_TYPE (val) != field_type)
          if (VALUE_TYPE (val) != field_type)
            val = value_cast (field_type, val);
            val = value_cast (field_type, val);
 
 
          bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
          bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
          bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
          bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
          if (variantno >= 0)
          if (variantno >= 0)
            bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
            bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
          addr = VALUE_CONTENTS (struct_val) + bitpos / 8;
          addr = VALUE_CONTENTS (struct_val) + bitpos / 8;
          if (bitsize)
          if (bitsize)
            modify_field (addr, value_as_long (val),
            modify_field (addr, value_as_long (val),
                          bitpos % 8, bitsize);
                          bitpos % 8, bitsize);
          else
          else
            memcpy (addr, VALUE_CONTENTS (val),
            memcpy (addr, VALUE_CONTENTS (val),
                    TYPE_LENGTH (VALUE_TYPE (val)));
                    TYPE_LENGTH (VALUE_TYPE (val)));
        }
        }
      while (--nlabels > 0);
      while (--nlabels > 0);
    }
    }
  return struct_val;
  return struct_val;
}
}
 
 
/* Recursive helper function for setting elements of array tuples for Chill.
/* Recursive helper function for setting elements of array tuples for Chill.
   The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND);
   The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND);
   the element value is ELEMENT;
   the element value is ELEMENT;
   EXP, POS and NOSIDE are as usual.
   EXP, POS and NOSIDE are as usual.
   Evaluates index expresions and sets the specified element(s) of
   Evaluates index expresions and sets the specified element(s) of
   ARRAY to ELEMENT.
   ARRAY to ELEMENT.
   Returns last index value.  */
   Returns last index value.  */
 
 
static LONGEST
static LONGEST
init_array_element (array, element, exp, pos, noside, low_bound, high_bound)
init_array_element (array, element, exp, pos, noside, low_bound, high_bound)
     value_ptr array, element;
     value_ptr array, element;
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
     enum noside noside;
     enum noside noside;
     LONGEST low_bound, high_bound;
     LONGEST low_bound, high_bound;
{
{
  LONGEST index;
  LONGEST index;
  int element_size = TYPE_LENGTH (VALUE_TYPE (element));
  int element_size = TYPE_LENGTH (VALUE_TYPE (element));
  if (exp->elts[*pos].opcode == BINOP_COMMA)
  if (exp->elts[*pos].opcode == BINOP_COMMA)
    {
    {
      (*pos)++;
      (*pos)++;
      init_array_element (array, element, exp, pos, noside,
      init_array_element (array, element, exp, pos, noside,
                          low_bound, high_bound);
                          low_bound, high_bound);
      return init_array_element (array, element,
      return init_array_element (array, element,
                                 exp, pos, noside, low_bound, high_bound);
                                 exp, pos, noside, low_bound, high_bound);
    }
    }
  else if (exp->elts[*pos].opcode == BINOP_RANGE)
  else if (exp->elts[*pos].opcode == BINOP_RANGE)
    {
    {
      LONGEST low, high;
      LONGEST low, high;
      (*pos)++;
      (*pos)++;
      low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      if (low < low_bound || high > high_bound)
      if (low < low_bound || high > high_bound)
        error ("tuple range index out of range");
        error ("tuple range index out of range");
      for (index = low; index <= high; index++)
      for (index = low; index <= high; index++)
        {
        {
          memcpy (VALUE_CONTENTS_RAW (array)
          memcpy (VALUE_CONTENTS_RAW (array)
                  + (index - low_bound) * element_size,
                  + (index - low_bound) * element_size,
                  VALUE_CONTENTS (element), element_size);
                  VALUE_CONTENTS (element), element_size);
        }
        }
    }
    }
  else
  else
    {
    {
      index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      if (index < low_bound || index > high_bound)
      if (index < low_bound || index > high_bound)
        error ("tuple index out of range");
        error ("tuple index out of range");
      memcpy (VALUE_CONTENTS_RAW (array) + (index - low_bound) * element_size,
      memcpy (VALUE_CONTENTS_RAW (array) + (index - low_bound) * element_size,
              VALUE_CONTENTS (element), element_size);
              VALUE_CONTENTS (element), element_size);
    }
    }
  return index;
  return index;
}
}
 
 
value_ptr
value_ptr
evaluate_subexp_standard (expect_type, exp, pos, noside)
evaluate_subexp_standard (expect_type, exp, pos, noside)
     struct type *expect_type;
     struct type *expect_type;
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
     enum noside noside;
     enum noside noside;
{
{
  enum exp_opcode op;
  enum exp_opcode op;
  int tem, tem2, tem3;
  int tem, tem2, tem3;
  register int pc, pc2 = 0, oldpos;
  register int pc, pc2 = 0, oldpos;
  register value_ptr arg1 = NULL, arg2 = NULL, arg3;
  register value_ptr arg1 = NULL, arg2 = NULL, arg3;
  struct type *type;
  struct type *type;
  int nargs;
  int nargs;
  value_ptr *argvec;
  value_ptr *argvec;
  int upper, lower, retcode;
  int upper, lower, retcode;
  int code;
  int code;
  int ix;
  int ix;
  long mem_offset;
  long mem_offset;
  struct type **arg_types;
  struct type **arg_types;
  int save_pos1;
  int save_pos1;
 
 
  pc = (*pos)++;
  pc = (*pos)++;
  op = exp->elts[pc].opcode;
  op = exp->elts[pc].opcode;
 
 
  switch (op)
  switch (op)
    {
    {
    case OP_SCOPE:
    case OP_SCOPE:
      tem = longest_to_int (exp->elts[pc + 2].longconst);
      tem = longest_to_int (exp->elts[pc + 2].longconst);
      (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
      (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
      arg1 = value_struct_elt_for_reference (exp->elts[pc + 1].type,
      arg1 = value_struct_elt_for_reference (exp->elts[pc + 1].type,
                                             0,
                                             0,
                                             exp->elts[pc + 1].type,
                                             exp->elts[pc + 1].type,
                                             &exp->elts[pc + 3].string,
                                             &exp->elts[pc + 3].string,
                                             NULL_TYPE);
                                             NULL_TYPE);
      if (arg1 == NULL)
      if (arg1 == NULL)
        error ("There is no field named %s", &exp->elts[pc + 3].string);
        error ("There is no field named %s", &exp->elts[pc + 3].string);
      return arg1;
      return arg1;
 
 
    case OP_LONG:
    case OP_LONG:
      (*pos) += 3;
      (*pos) += 3;
      return value_from_longest (exp->elts[pc + 1].type,
      return value_from_longest (exp->elts[pc + 1].type,
                                 exp->elts[pc + 2].longconst);
                                 exp->elts[pc + 2].longconst);
 
 
    case OP_DOUBLE:
    case OP_DOUBLE:
      (*pos) += 3;
      (*pos) += 3;
      return value_from_double (exp->elts[pc + 1].type,
      return value_from_double (exp->elts[pc + 1].type,
                                exp->elts[pc + 2].doubleconst);
                                exp->elts[pc + 2].doubleconst);
 
 
    case OP_VAR_VALUE:
    case OP_VAR_VALUE:
      (*pos) += 3;
      (*pos) += 3;
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
 
 
      /* JYG: We used to just return value_zero of the symbol type
      /* JYG: We used to just return value_zero of the symbol type
         if we're asked to avoid side effects.  Otherwise we return
         if we're asked to avoid side effects.  Otherwise we return
         value_of_variable (...).  However I'm not sure if
         value_of_variable (...).  However I'm not sure if
         value_of_variable () has any side effect.
         value_of_variable () has any side effect.
         We need a full value object returned here for whatis_exp ()
         We need a full value object returned here for whatis_exp ()
         to call evaluate_type () and then pass the full value to
         to call evaluate_type () and then pass the full value to
         value_rtti_target_type () if we are dealing with a pointer
         value_rtti_target_type () if we are dealing with a pointer
         or reference to a base class and print object is on. */
         or reference to a base class and print object is on. */
 
 
        return value_of_variable (exp->elts[pc + 2].symbol,
        return value_of_variable (exp->elts[pc + 2].symbol,
                                  exp->elts[pc + 1].block);
                                  exp->elts[pc + 1].block);
 
 
    case OP_LAST:
    case OP_LAST:
      (*pos) += 2;
      (*pos) += 2;
      return
      return
        access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
        access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
 
 
    case OP_REGISTER:
    case OP_REGISTER:
      {
      {
        int regno = longest_to_int (exp->elts[pc + 1].longconst);
        int regno = longest_to_int (exp->elts[pc + 1].longconst);
        value_ptr val = value_of_register (regno);
        value_ptr val = value_of_register (regno);
 
 
        (*pos) += 2;
        (*pos) += 2;
        if (val == NULL)
        if (val == NULL)
          error ("Value of register %s not available.", REGISTER_NAME (regno));
          error ("Value of register %s not available.", REGISTER_NAME (regno));
        else
        else
          return val;
          return val;
      }
      }
    case OP_BOOL:
    case OP_BOOL:
      (*pos) += 2;
      (*pos) += 2;
      return value_from_longest (LA_BOOL_TYPE,
      return value_from_longest (LA_BOOL_TYPE,
                                 exp->elts[pc + 1].longconst);
                                 exp->elts[pc + 1].longconst);
 
 
    case OP_INTERNALVAR:
    case OP_INTERNALVAR:
      (*pos) += 2;
      (*pos) += 2;
      return value_of_internalvar (exp->elts[pc + 1].internalvar);
      return value_of_internalvar (exp->elts[pc + 1].internalvar);
 
 
    case OP_STRING:
    case OP_STRING:
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      return value_string (&exp->elts[pc + 2].string, tem);
      return value_string (&exp->elts[pc + 2].string, tem);
 
 
    case OP_BITSTRING:
    case OP_BITSTRING:
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos)
      (*pos)
        += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
        += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      return value_bitstring (&exp->elts[pc + 2].string, tem);
      return value_bitstring (&exp->elts[pc + 2].string, tem);
      break;
      break;
 
 
    case OP_ARRAY:
    case OP_ARRAY:
      (*pos) += 3;
      (*pos) += 3;
      tem2 = longest_to_int (exp->elts[pc + 1].longconst);
      tem2 = longest_to_int (exp->elts[pc + 1].longconst);
      tem3 = longest_to_int (exp->elts[pc + 2].longconst);
      tem3 = longest_to_int (exp->elts[pc + 2].longconst);
      nargs = tem3 - tem2 + 1;
      nargs = tem3 - tem2 + 1;
      type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
      type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 
 
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
          && TYPE_CODE (type) == TYPE_CODE_STRUCT)
          && TYPE_CODE (type) == TYPE_CODE_STRUCT)
        {
        {
          value_ptr rec = allocate_value (expect_type);
          value_ptr rec = allocate_value (expect_type);
          memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
          memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
          return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
          return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
        }
        }
 
 
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
          && TYPE_CODE (type) == TYPE_CODE_ARRAY)
          && TYPE_CODE (type) == TYPE_CODE_ARRAY)
        {
        {
          struct type *range_type = TYPE_FIELD_TYPE (type, 0);
          struct type *range_type = TYPE_FIELD_TYPE (type, 0);
          struct type *element_type = TYPE_TARGET_TYPE (type);
          struct type *element_type = TYPE_TARGET_TYPE (type);
          value_ptr array = allocate_value (expect_type);
          value_ptr array = allocate_value (expect_type);
          int element_size = TYPE_LENGTH (check_typedef (element_type));
          int element_size = TYPE_LENGTH (check_typedef (element_type));
          LONGEST low_bound, high_bound, index;
          LONGEST low_bound, high_bound, index;
          if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
          if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
            {
            {
              low_bound = 0;
              low_bound = 0;
              high_bound = (TYPE_LENGTH (type) / element_size) - 1;
              high_bound = (TYPE_LENGTH (type) / element_size) - 1;
            }
            }
          index = low_bound;
          index = low_bound;
          memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
          memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
          for (tem = nargs; --nargs >= 0;)
          for (tem = nargs; --nargs >= 0;)
            {
            {
              value_ptr element;
              value_ptr element;
              int index_pc = 0;
              int index_pc = 0;
              if (exp->elts[*pos].opcode == BINOP_RANGE)
              if (exp->elts[*pos].opcode == BINOP_RANGE)
                {
                {
                  index_pc = ++(*pos);
                  index_pc = ++(*pos);
                  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
                  evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
                }
                }
              element = evaluate_subexp (element_type, exp, pos, noside);
              element = evaluate_subexp (element_type, exp, pos, noside);
              if (VALUE_TYPE (element) != element_type)
              if (VALUE_TYPE (element) != element_type)
                element = value_cast (element_type, element);
                element = value_cast (element_type, element);
              if (index_pc)
              if (index_pc)
                {
                {
                  int continue_pc = *pos;
                  int continue_pc = *pos;
                  *pos = index_pc;
                  *pos = index_pc;
                  index = init_array_element (array, element, exp, pos, noside,
                  index = init_array_element (array, element, exp, pos, noside,
                                              low_bound, high_bound);
                                              low_bound, high_bound);
                  *pos = continue_pc;
                  *pos = continue_pc;
                }
                }
              else
              else
                {
                {
                  if (index > high_bound)
                  if (index > high_bound)
                    /* to avoid memory corruption */
                    /* to avoid memory corruption */
                    error ("Too many array elements");
                    error ("Too many array elements");
                  memcpy (VALUE_CONTENTS_RAW (array)
                  memcpy (VALUE_CONTENTS_RAW (array)
                          + (index - low_bound) * element_size,
                          + (index - low_bound) * element_size,
                          VALUE_CONTENTS (element),
                          VALUE_CONTENTS (element),
                          element_size);
                          element_size);
                }
                }
              index++;
              index++;
            }
            }
          return array;
          return array;
        }
        }
 
 
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
      if (expect_type != NULL_TYPE && noside != EVAL_SKIP
          && TYPE_CODE (type) == TYPE_CODE_SET)
          && TYPE_CODE (type) == TYPE_CODE_SET)
        {
        {
          value_ptr set = allocate_value (expect_type);
          value_ptr set = allocate_value (expect_type);
          char *valaddr = VALUE_CONTENTS_RAW (set);
          char *valaddr = VALUE_CONTENTS_RAW (set);
          struct type *element_type = TYPE_INDEX_TYPE (type);
          struct type *element_type = TYPE_INDEX_TYPE (type);
          struct type *check_type = element_type;
          struct type *check_type = element_type;
          LONGEST low_bound, high_bound;
          LONGEST low_bound, high_bound;
 
 
          /* get targettype of elementtype */
          /* get targettype of elementtype */
          while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
          while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
                 TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
                 TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
            check_type = TYPE_TARGET_TYPE (check_type);
            check_type = TYPE_TARGET_TYPE (check_type);
 
 
          if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
          if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
            error ("(power)set type with unknown size");
            error ("(power)set type with unknown size");
          memset (valaddr, '\0', TYPE_LENGTH (type));
          memset (valaddr, '\0', TYPE_LENGTH (type));
          for (tem = 0; tem < nargs; tem++)
          for (tem = 0; tem < nargs; tem++)
            {
            {
              LONGEST range_low, range_high;
              LONGEST range_low, range_high;
              struct type *range_low_type, *range_high_type;
              struct type *range_low_type, *range_high_type;
              value_ptr elem_val;
              value_ptr elem_val;
              if (exp->elts[*pos].opcode == BINOP_RANGE)
              if (exp->elts[*pos].opcode == BINOP_RANGE)
                {
                {
                  (*pos)++;
                  (*pos)++;
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
                  range_low_type = VALUE_TYPE (elem_val);
                  range_low_type = VALUE_TYPE (elem_val);
                  range_low = value_as_long (elem_val);
                  range_low = value_as_long (elem_val);
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
                  range_high_type = VALUE_TYPE (elem_val);
                  range_high_type = VALUE_TYPE (elem_val);
                  range_high = value_as_long (elem_val);
                  range_high = value_as_long (elem_val);
                }
                }
              else
              else
                {
                {
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
                  elem_val = evaluate_subexp (element_type, exp, pos, noside);
                  range_low_type = range_high_type = VALUE_TYPE (elem_val);
                  range_low_type = range_high_type = VALUE_TYPE (elem_val);
                  range_low = range_high = value_as_long (elem_val);
                  range_low = range_high = value_as_long (elem_val);
                }
                }
              /* check types of elements to avoid mixture of elements from
              /* check types of elements to avoid mixture of elements from
                 different types. Also check if type of element is "compatible"
                 different types. Also check if type of element is "compatible"
                 with element type of powerset */
                 with element type of powerset */
              if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
              if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
                range_low_type = TYPE_TARGET_TYPE (range_low_type);
                range_low_type = TYPE_TARGET_TYPE (range_low_type);
              if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
              if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
                range_high_type = TYPE_TARGET_TYPE (range_high_type);
                range_high_type = TYPE_TARGET_TYPE (range_high_type);
              if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
              if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
                  (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
                  (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
                   (range_low_type != range_high_type)))
                   (range_low_type != range_high_type)))
                /* different element modes */
                /* different element modes */
                error ("POWERSET tuple elements of different mode");
                error ("POWERSET tuple elements of different mode");
              if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
              if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
                  (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
                  (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
                   range_low_type != check_type))
                   range_low_type != check_type))
                error ("incompatible POWERSET tuple elements");
                error ("incompatible POWERSET tuple elements");
              if (range_low > range_high)
              if (range_low > range_high)
                {
                {
                  warning ("empty POWERSET tuple range");
                  warning ("empty POWERSET tuple range");
                  continue;
                  continue;
                }
                }
              if (range_low < low_bound || range_high > high_bound)
              if (range_low < low_bound || range_high > high_bound)
                error ("POWERSET tuple element out of range");
                error ("POWERSET tuple element out of range");
              range_low -= low_bound;
              range_low -= low_bound;
              range_high -= low_bound;
              range_high -= low_bound;
              for (; range_low <= range_high; range_low++)
              for (; range_low <= range_high; range_low++)
                {
                {
                  int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
                  int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
                  if (BITS_BIG_ENDIAN)
                  if (BITS_BIG_ENDIAN)
                    bit_index = TARGET_CHAR_BIT - 1 - bit_index;
                    bit_index = TARGET_CHAR_BIT - 1 - bit_index;
                  valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
                  valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
                    |= 1 << bit_index;
                    |= 1 << bit_index;
                }
                }
            }
            }
          return set;
          return set;
        }
        }
 
 
      argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
      argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
      for (tem = 0; tem < nargs; tem++)
      for (tem = 0; tem < nargs; tem++)
        {
        {
          /* Ensure that array expressions are coerced into pointer objects. */
          /* Ensure that array expressions are coerced into pointer objects. */
          argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
          argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
        }
        }
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      return value_array (tem2, tem3, argvec);
      return value_array (tem2, tem3, argvec);
 
 
    case TERNOP_SLICE:
    case TERNOP_SLICE:
      {
      {
        value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
        value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
        int lowbound
        int lowbound
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        int upper
        int upper
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        if (noside == EVAL_SKIP)
        if (noside == EVAL_SKIP)
          goto nosideret;
          goto nosideret;
        return value_slice (array, lowbound, upper - lowbound + 1);
        return value_slice (array, lowbound, upper - lowbound + 1);
      }
      }
 
 
    case TERNOP_SLICE_COUNT:
    case TERNOP_SLICE_COUNT:
      {
      {
        value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
        value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
        int lowbound
        int lowbound
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        int length
        int length
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
        return value_slice (array, lowbound, length);
        return value_slice (array, lowbound, length);
      }
      }
 
 
    case TERNOP_COND:
    case TERNOP_COND:
      /* Skip third and second args to evaluate the first one.  */
      /* Skip third and second args to evaluate the first one.  */
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (value_logical_not (arg1))
      if (value_logical_not (arg1))
        {
        {
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          return evaluate_subexp (NULL_TYPE, exp, pos, noside);
          return evaluate_subexp (NULL_TYPE, exp, pos, noside);
        }
        }
      else
      else
        {
        {
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          return arg2;
          return arg2;
        }
        }
 
 
    case OP_FUNCALL:
    case OP_FUNCALL:
      (*pos) += 2;
      (*pos) += 2;
      op = exp->elts[*pos].opcode;
      op = exp->elts[*pos].opcode;
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      /* Allocate arg vector, including space for the function to be
      /* Allocate arg vector, including space for the function to be
         called in argvec[0] and a terminating NULL */
         called in argvec[0] and a terminating NULL */
      argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 3));
      argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 3));
      if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
      if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
        {
        {
          LONGEST fnptr;
          LONGEST fnptr;
 
 
          /* 1997-08-01 Currently we do not support function invocation
          /* 1997-08-01 Currently we do not support function invocation
             via pointers-to-methods with HP aCC. Pointer does not point
             via pointers-to-methods with HP aCC. Pointer does not point
             to the function, but possibly to some thunk. */
             to the function, but possibly to some thunk. */
          if (hp_som_som_object_present)
          if (hp_som_som_object_present)
            {
            {
              error ("Not implemented: function invocation through pointer to method with HP aCC");
              error ("Not implemented: function invocation through pointer to method with HP aCC");
            }
            }
 
 
          nargs++;
          nargs++;
          /* First, evaluate the structure into arg2 */
          /* First, evaluate the structure into arg2 */
          pc2 = (*pos)++;
          pc2 = (*pos)++;
 
 
          if (noside == EVAL_SKIP)
          if (noside == EVAL_SKIP)
            goto nosideret;
            goto nosideret;
 
 
          if (op == STRUCTOP_MEMBER)
          if (op == STRUCTOP_MEMBER)
            {
            {
              arg2 = evaluate_subexp_for_address (exp, pos, noside);
              arg2 = evaluate_subexp_for_address (exp, pos, noside);
            }
            }
          else
          else
            {
            {
              arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
              arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
            }
            }
 
 
          /* If the function is a virtual function, then the
          /* If the function is a virtual function, then the
             aggregate value (providing the structure) plays
             aggregate value (providing the structure) plays
             its part by providing the vtable.  Otherwise,
             its part by providing the vtable.  Otherwise,
             it is just along for the ride: call the function
             it is just along for the ride: call the function
             directly.  */
             directly.  */
 
 
          arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
 
          fnptr = value_as_long (arg1);
          fnptr = value_as_long (arg1);
 
 
          if (METHOD_PTR_IS_VIRTUAL (fnptr))
          if (METHOD_PTR_IS_VIRTUAL (fnptr))
            {
            {
              int fnoffset = METHOD_PTR_TO_VOFFSET (fnptr);
              int fnoffset = METHOD_PTR_TO_VOFFSET (fnptr);
              struct type *basetype;
              struct type *basetype;
              struct type *domain_type =
              struct type *domain_type =
              TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
              TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
              int i, j;
              int i, j;
              basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
              basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
              if (domain_type != basetype)
              if (domain_type != basetype)
                arg2 = value_cast (lookup_pointer_type (domain_type), arg2);
                arg2 = value_cast (lookup_pointer_type (domain_type), arg2);
              basetype = TYPE_VPTR_BASETYPE (domain_type);
              basetype = TYPE_VPTR_BASETYPE (domain_type);
              for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
              for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
                {
                {
                  struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
                  struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
                  /* If one is virtual, then all are virtual.  */
                  /* If one is virtual, then all are virtual.  */
                  if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
                  if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
                    for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
                    for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
                      if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
                      if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
                        {
                        {
                          value_ptr temp = value_ind (arg2);
                          value_ptr temp = value_ind (arg2);
                          arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
                          arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
                          arg2 = value_addr (temp);
                          arg2 = value_addr (temp);
                          goto got_it;
                          goto got_it;
                        }
                        }
                }
                }
              if (i < 0)
              if (i < 0)
                error ("virtual function at index %d not found", fnoffset);
                error ("virtual function at index %d not found", fnoffset);
            }
            }
          else
          else
            {
            {
              VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
              VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
            }
            }
        got_it:
        got_it:
 
 
          /* Now, say which argument to start evaluating from */
          /* Now, say which argument to start evaluating from */
          tem = 2;
          tem = 2;
        }
        }
      else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
      else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
        {
        {
          /* Hair for method invocations */
          /* Hair for method invocations */
          int tem2;
          int tem2;
 
 
          nargs++;
          nargs++;
          /* First, evaluate the structure into arg2 */
          /* First, evaluate the structure into arg2 */
          pc2 = (*pos)++;
          pc2 = (*pos)++;
          tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
          tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
          *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
          *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
          if (noside == EVAL_SKIP)
          if (noside == EVAL_SKIP)
            goto nosideret;
            goto nosideret;
 
 
          if (op == STRUCTOP_STRUCT)
          if (op == STRUCTOP_STRUCT)
            {
            {
              /* If v is a variable in a register, and the user types
              /* If v is a variable in a register, and the user types
                 v.method (), this will produce an error, because v has
                 v.method (), this will produce an error, because v has
                 no address.
                 no address.
 
 
                 A possible way around this would be to allocate a
                 A possible way around this would be to allocate a
                 copy of the variable on the stack, copy in the
                 copy of the variable on the stack, copy in the
                 contents, call the function, and copy out the
                 contents, call the function, and copy out the
                 contents.  I.e. convert this from call by reference
                 contents.  I.e. convert this from call by reference
                 to call by copy-return (or whatever it's called).
                 to call by copy-return (or whatever it's called).
                 However, this does not work because it is not the
                 However, this does not work because it is not the
                 same: the method being called could stash a copy of
                 same: the method being called could stash a copy of
                 the address, and then future uses through that address
                 the address, and then future uses through that address
                 (after the method returns) would be expected to
                 (after the method returns) would be expected to
                 use the variable itself, not some copy of it.  */
                 use the variable itself, not some copy of it.  */
              arg2 = evaluate_subexp_for_address (exp, pos, noside);
              arg2 = evaluate_subexp_for_address (exp, pos, noside);
            }
            }
          else
          else
            {
            {
              arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
              arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
            }
            }
          /* Now, say which argument to start evaluating from */
          /* Now, say which argument to start evaluating from */
          tem = 2;
          tem = 2;
        }
        }
      else
      else
        {
        {
          /* Non-method function call */
          /* Non-method function call */
          save_pos1 = *pos;
          save_pos1 = *pos;
          argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
          argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
          tem = 1;
          tem = 1;
          type = VALUE_TYPE (argvec[0]);
          type = VALUE_TYPE (argvec[0]);
          if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
          if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
            type = TYPE_TARGET_TYPE (type);
            type = TYPE_TARGET_TYPE (type);
          if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
          if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
            {
            {
              for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
              for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
                {
                {
                  /* pai: FIXME This seems to be coercing arguments before
                  /* pai: FIXME This seems to be coercing arguments before
                   * overload resolution has been done! */
                   * overload resolution has been done! */
                  argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
                  argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
                                                 exp, pos, noside);
                                                 exp, pos, noside);
                }
                }
            }
            }
        }
        }
 
 
      /* Evaluate arguments */
      /* Evaluate arguments */
      for (; tem <= nargs; tem++)
      for (; tem <= nargs; tem++)
        {
        {
          /* Ensure that array expressions are coerced into pointer objects. */
          /* Ensure that array expressions are coerced into pointer objects. */
          argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
          argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
        }
        }
 
 
      /* signal end of arglist */
      /* signal end of arglist */
      argvec[tem] = 0;
      argvec[tem] = 0;
 
 
      if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
      if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
        {
        {
          int static_memfuncp;
          int static_memfuncp;
          value_ptr temp = arg2;
          value_ptr temp = arg2;
          char tstr[256];
          char tstr[256];
 
 
          /* Method invocation : stuff "this" as first parameter */
          /* Method invocation : stuff "this" as first parameter */
          /* pai: this used to have lookup_pointer_type for some reason,
          /* pai: this used to have lookup_pointer_type for some reason,
           * but temp is already a pointer to the object */
           * but temp is already a pointer to the object */
          argvec[1] = value_from_longest (VALUE_TYPE (temp),
          argvec[1] = value_from_longest (VALUE_TYPE (temp),
                                VALUE_ADDRESS (temp) + VALUE_OFFSET (temp));
                                VALUE_ADDRESS (temp) + VALUE_OFFSET (temp));
          /* Name of method from expression */
          /* Name of method from expression */
          strcpy (tstr, &exp->elts[pc2 + 2].string);
          strcpy (tstr, &exp->elts[pc2 + 2].string);
 
 
          if (overload_resolution && (exp->language_defn->la_language == language_cplus))
          if (overload_resolution && (exp->language_defn->la_language == language_cplus))
            {
            {
              /* Language is C++, do some overload resolution before evaluation */
              /* Language is C++, do some overload resolution before evaluation */
              value_ptr valp = NULL;
              value_ptr valp = NULL;
 
 
              /* Prepare list of argument types for overload resolution */
              /* Prepare list of argument types for overload resolution */
              arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
              arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
              for (ix = 1; ix <= nargs; ix++)
              for (ix = 1; ix <= nargs; ix++)
                arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
                arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
 
 
              (void) find_overload_match (arg_types, nargs, tstr,
              (void) find_overload_match (arg_types, nargs, tstr,
                                     1 /* method */ , 0 /* strict match */ ,
                                     1 /* method */ , 0 /* strict match */ ,
                                          arg2 /* the object */ , NULL,
                                          arg2 /* the object */ , NULL,
                                          &valp, NULL, &static_memfuncp);
                                          &valp, NULL, &static_memfuncp);
 
 
 
 
              argvec[1] = arg2; /* the ``this'' pointer */
              argvec[1] = arg2; /* the ``this'' pointer */
              argvec[0] = valp;  /* use the method found after overload resolution */
              argvec[0] = valp;  /* use the method found after overload resolution */
            }
            }
          else
          else
            /* Non-C++ case -- or no overload resolution */
            /* Non-C++ case -- or no overload resolution */
            {
            {
              temp = arg2;
              temp = arg2;
              argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
              argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
                                            &static_memfuncp,
                                            &static_memfuncp,
                                            op == STRUCTOP_STRUCT
                                            op == STRUCTOP_STRUCT
                                       ? "structure" : "structure pointer");
                                       ? "structure" : "structure pointer");
              argvec[1] = arg2; /* the ``this'' pointer */
              argvec[1] = arg2; /* the ``this'' pointer */
            }
            }
 
 
          if (static_memfuncp)
          if (static_memfuncp)
            {
            {
              argvec[1] = argvec[0];
              argvec[1] = argvec[0];
              nargs--;
              nargs--;
              argvec++;
              argvec++;
            }
            }
        }
        }
      else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
      else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
        {
        {
          argvec[1] = arg2;
          argvec[1] = arg2;
          argvec[0] = arg1;
          argvec[0] = arg1;
        }
        }
      else if (op == OP_VAR_VALUE)
      else if (op == OP_VAR_VALUE)
        {
        {
          /* Non-member function being called */
          /* Non-member function being called */
          /* fn: This can only be done for C++ functions.  A C-style function
          /* fn: This can only be done for C++ functions.  A C-style function
             in a C++ program, for instance, does not have the fields that
             in a C++ program, for instance, does not have the fields that
             are expected here */
             are expected here */
 
 
          if (overload_resolution && (exp->language_defn->la_language == language_cplus))
          if (overload_resolution && (exp->language_defn->la_language == language_cplus))
            {
            {
              /* Language is C++, do some overload resolution before evaluation */
              /* Language is C++, do some overload resolution before evaluation */
              struct symbol *symp;
              struct symbol *symp;
 
 
              /* Prepare list of argument types for overload resolution */
              /* Prepare list of argument types for overload resolution */
              arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
              arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
              for (ix = 1; ix <= nargs; ix++)
              for (ix = 1; ix <= nargs; ix++)
                arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
                arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
 
 
              (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
              (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
                                 0 /* not method */ , 0 /* strict match */ ,
                                 0 /* not method */ , 0 /* strict match */ ,
                      NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
                      NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
                                          NULL, &symp, NULL);
                                          NULL, &symp, NULL);
 
 
              /* Now fix the expression being evaluated */
              /* Now fix the expression being evaluated */
              exp->elts[save_pos1+2].symbol = symp;
              exp->elts[save_pos1+2].symbol = symp;
              argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
              argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
            }
            }
          else
          else
            {
            {
              /* Not C++, or no overload resolution allowed */
              /* Not C++, or no overload resolution allowed */
              /* nothing to be done; argvec already correctly set up */
              /* nothing to be done; argvec already correctly set up */
            }
            }
        }
        }
      else
      else
        {
        {
          /* It is probably a C-style function */
          /* It is probably a C-style function */
          /* nothing to be done; argvec already correctly set up */
          /* nothing to be done; argvec already correctly set up */
        }
        }
 
 
    do_call_it:
    do_call_it:
 
 
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        {
        {
          /* If the return type doesn't look like a function type, call an
          /* If the return type doesn't look like a function type, call an
             error.  This can happen if somebody tries to turn a variable into
             error.  This can happen if somebody tries to turn a variable into
             a function call. This is here because people often want to
             a function call. This is here because people often want to
             call, eg, strcmp, which gdb doesn't know is a function.  If
             call, eg, strcmp, which gdb doesn't know is a function.  If
             gdb isn't asked for it's opinion (ie. through "whatis"),
             gdb isn't asked for it's opinion (ie. through "whatis"),
             it won't offer it. */
             it won't offer it. */
 
 
          struct type *ftype =
          struct type *ftype =
          TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
          TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
 
 
          if (ftype)
          if (ftype)
            return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
            return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
          else
          else
            error ("Expression of type other than \"Function returning ...\" used as function");
            error ("Expression of type other than \"Function returning ...\" used as function");
        }
        }
      if (argvec[0] == NULL)
      if (argvec[0] == NULL)
        error ("Cannot evaluate function -- may be inlined");
        error ("Cannot evaluate function -- may be inlined");
      return call_function_by_hand (argvec[0], nargs, argvec + 1);
      return call_function_by_hand (argvec[0], nargs, argvec + 1);
      /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
      /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
 
 
    case OP_F77_UNDETERMINED_ARGLIST:
    case OP_F77_UNDETERMINED_ARGLIST:
 
 
      /* Remember that in F77, functions, substring ops and
      /* Remember that in F77, functions, substring ops and
         array subscript operations cannot be disambiguated
         array subscript operations cannot be disambiguated
         at parse time.  We have made all array subscript operations,
         at parse time.  We have made all array subscript operations,
         substring operations as well as function calls  come here
         substring operations as well as function calls  come here
         and we now have to discover what the heck this thing actually was.
         and we now have to discover what the heck this thing actually was.
         If it is a function, we process just as if we got an OP_FUNCALL. */
         If it is a function, we process just as if we got an OP_FUNCALL. */
 
 
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos) += 2;
      (*pos) += 2;
 
 
      /* First determine the type code we are dealing with.  */
      /* First determine the type code we are dealing with.  */
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      type = check_typedef (VALUE_TYPE (arg1));
      type = check_typedef (VALUE_TYPE (arg1));
      code = TYPE_CODE (type);
      code = TYPE_CODE (type);
 
 
      switch (code)
      switch (code)
        {
        {
        case TYPE_CODE_ARRAY:
        case TYPE_CODE_ARRAY:
          goto multi_f77_subscript;
          goto multi_f77_subscript;
 
 
        case TYPE_CODE_STRING:
        case TYPE_CODE_STRING:
          goto op_f77_substr;
          goto op_f77_substr;
 
 
        case TYPE_CODE_PTR:
        case TYPE_CODE_PTR:
        case TYPE_CODE_FUNC:
        case TYPE_CODE_FUNC:
          /* It's a function call. */
          /* It's a function call. */
          /* Allocate arg vector, including space for the function to be
          /* Allocate arg vector, including space for the function to be
             called in argvec[0] and a terminating NULL */
             called in argvec[0] and a terminating NULL */
          argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
          argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
          argvec[0] = arg1;
          argvec[0] = arg1;
          tem = 1;
          tem = 1;
          for (; tem <= nargs; tem++)
          for (; tem <= nargs; tem++)
            argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
            argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
          argvec[tem] = 0;       /* signal end of arglist */
          argvec[tem] = 0;       /* signal end of arglist */
          goto do_call_it;
          goto do_call_it;
 
 
        default:
        default:
          error ("Cannot perform substring on this type");
          error ("Cannot perform substring on this type");
        }
        }
 
 
    op_f77_substr:
    op_f77_substr:
      /* We have a substring operation on our hands here,
      /* We have a substring operation on our hands here,
         let us get the string we will be dealing with */
         let us get the string we will be dealing with */
 
 
      /* Now evaluate the 'from' and 'to' */
      /* Now evaluate the 'from' and 'to' */
 
 
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 
 
      if (nargs < 2)
      if (nargs < 2)
        return value_subscript (arg1, arg2);
        return value_subscript (arg1, arg2);
 
 
      arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
 
 
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
 
 
      tem2 = value_as_long (arg2);
      tem2 = value_as_long (arg2);
      tem3 = value_as_long (arg3);
      tem3 = value_as_long (arg3);
 
 
      return value_slice (arg1, tem2, tem3 - tem2 + 1);
      return value_slice (arg1, tem2, tem3 - tem2 + 1);
 
 
    case OP_COMPLEX:
    case OP_COMPLEX:
      /* We have a complex number, There should be 2 floating
      /* We have a complex number, There should be 2 floating
         point numbers that compose it */
         point numbers that compose it */
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
 
      return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
      return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
 
 
    case STRUCTOP_STRUCT:
    case STRUCTOP_STRUCT:
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
        return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
                                                   &exp->elts[pc + 2].string,
                                                   &exp->elts[pc + 2].string,
                                                   0),
                                                   0),
                           lval_memory);
                           lval_memory);
      else
      else
        {
        {
          value_ptr temp = arg1;
          value_ptr temp = arg1;
          return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
          return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
                                   NULL, "structure");
                                   NULL, "structure");
        }
        }
 
 
    case STRUCTOP_PTR:
    case STRUCTOP_PTR:
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      tem = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
 
 
      /* JYG: if print object is on we need to replace the base type
      /* JYG: if print object is on we need to replace the base type
         with rtti type in order to continue on with successful
         with rtti type in order to continue on with successful
         lookup of member / method only available in the rtti type. */
         lookup of member / method only available in the rtti type. */
      {
      {
        struct type *type = VALUE_TYPE (arg1);
        struct type *type = VALUE_TYPE (arg1);
        struct type *real_type;
        struct type *real_type;
        int full, top, using_enc;
        int full, top, using_enc;
 
 
        if (objectprint && TYPE_TARGET_TYPE(type) &&
        if (objectprint && TYPE_TARGET_TYPE(type) &&
            (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
            (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
          {
          {
            real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
            real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
            if (real_type)
            if (real_type)
              {
              {
                if (TYPE_CODE (type) == TYPE_CODE_PTR)
                if (TYPE_CODE (type) == TYPE_CODE_PTR)
                  real_type = lookup_pointer_type (real_type);
                  real_type = lookup_pointer_type (real_type);
                else
                else
                  real_type = lookup_reference_type (real_type);
                  real_type = lookup_reference_type (real_type);
 
 
                arg1 = value_cast (real_type, arg1);
                arg1 = value_cast (real_type, arg1);
              }
              }
          }
          }
      }
      }
 
 
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
        return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
                                                   &exp->elts[pc + 2].string,
                                                   &exp->elts[pc + 2].string,
                                                   0),
                                                   0),
                           lval_memory);
                           lval_memory);
      else
      else
        {
        {
          value_ptr temp = arg1;
          value_ptr temp = arg1;
          return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
          return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
                                   NULL, "structure pointer");
                                   NULL, "structure pointer");
        }
        }
 
 
    case STRUCTOP_MEMBER:
    case STRUCTOP_MEMBER:
      arg1 = evaluate_subexp_for_address (exp, pos, noside);
      arg1 = evaluate_subexp_for_address (exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
 
      /* With HP aCC, pointers to methods do not point to the function code */
      /* With HP aCC, pointers to methods do not point to the function code */
      if (hp_som_som_object_present &&
      if (hp_som_som_object_present &&
          (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
          (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
        error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
        error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
 
 
      mem_offset = value_as_long (arg2);
      mem_offset = value_as_long (arg2);
      goto handle_pointer_to_member;
      goto handle_pointer_to_member;
 
 
    case STRUCTOP_MPTR:
    case STRUCTOP_MPTR:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
 
      /* With HP aCC, pointers to methods do not point to the function code */
      /* With HP aCC, pointers to methods do not point to the function code */
      if (hp_som_som_object_present &&
      if (hp_som_som_object_present &&
          (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
          (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
      (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
        error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
        error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
 
 
      mem_offset = value_as_long (arg2);
      mem_offset = value_as_long (arg2);
 
 
    handle_pointer_to_member:
    handle_pointer_to_member:
      /* HP aCC generates offsets that have bit #29 set; turn it off to get
      /* HP aCC generates offsets that have bit #29 set; turn it off to get
         a real offset to the member. */
         a real offset to the member. */
      if (hp_som_som_object_present)
      if (hp_som_som_object_present)
        {
        {
          if (!mem_offset)      /* no bias -> really null */
          if (!mem_offset)      /* no bias -> really null */
            error ("Attempted dereference of null pointer-to-member");
            error ("Attempted dereference of null pointer-to-member");
          mem_offset &= ~0x20000000;
          mem_offset &= ~0x20000000;
        }
        }
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      type = check_typedef (VALUE_TYPE (arg2));
      type = check_typedef (VALUE_TYPE (arg2));
      if (TYPE_CODE (type) != TYPE_CODE_PTR)
      if (TYPE_CODE (type) != TYPE_CODE_PTR)
        goto bad_pointer_to_member;
        goto bad_pointer_to_member;
      type = check_typedef (TYPE_TARGET_TYPE (type));
      type = check_typedef (TYPE_TARGET_TYPE (type));
      if (TYPE_CODE (type) == TYPE_CODE_METHOD)
      if (TYPE_CODE (type) == TYPE_CODE_METHOD)
        error ("not implemented: pointer-to-method in pointer-to-member construct");
        error ("not implemented: pointer-to-method in pointer-to-member construct");
      if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
      if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
        goto bad_pointer_to_member;
        goto bad_pointer_to_member;
      /* Now, convert these values to an address.  */
      /* Now, convert these values to an address.  */
      arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
      arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
                         arg1);
                         arg1);
      arg3 = value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
      arg3 = value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
                                 value_as_long (arg1) + mem_offset);
                                 value_as_long (arg1) + mem_offset);
      return value_ind (arg3);
      return value_ind (arg3);
    bad_pointer_to_member:
    bad_pointer_to_member:
      error ("non-pointer-to-member value used in pointer-to-member construct");
      error ("non-pointer-to-member value used in pointer-to-member construct");
 
 
    case BINOP_CONCAT:
    case BINOP_CONCAT:
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      else
      else
        return value_concat (arg1, arg2);
        return value_concat (arg1, arg2);
 
 
    case BINOP_ASSIGN:
    case BINOP_ASSIGN:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
 
 
      /* Do special stuff for HP aCC pointers to members */
      /* Do special stuff for HP aCC pointers to members */
      if (hp_som_som_object_present)
      if (hp_som_som_object_present)
        {
        {
          /* 1997-08-19 Can't assign HP aCC pointers to methods. No details of
          /* 1997-08-19 Can't assign HP aCC pointers to methods. No details of
             the implementation yet; but the pointer appears to point to a code
             the implementation yet; but the pointer appears to point to a code
             sequence (thunk) in memory -- in any case it is *not* the address
             sequence (thunk) in memory -- in any case it is *not* the address
             of the function as it would be in a naive implementation. */
             of the function as it would be in a naive implementation. */
          if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
          if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD))
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD))
            error ("Assignment to pointers to methods not implemented with HP aCC");
            error ("Assignment to pointers to methods not implemented with HP aCC");
 
 
          /* HP aCC pointers to data members require a constant bias */
          /* HP aCC pointers to data members require a constant bias */
          if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
          if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER))
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER))
            {
            {
              unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (arg2);       /* forces evaluation */
              unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (arg2);       /* forces evaluation */
              *ptr |= 0x20000000;       /* set 29th bit */
              *ptr |= 0x20000000;       /* set 29th bit */
            }
            }
        }
        }
 
 
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
        return arg1;
        return arg1;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      else
      else
        return value_assign (arg1, arg2);
        return value_assign (arg1, arg2);
 
 
    case BINOP_ASSIGN_MODIFY:
    case BINOP_ASSIGN_MODIFY:
      (*pos) += 2;
      (*pos) += 2;
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
        return arg1;
        return arg1;
      op = exp->elts[pc + 1].opcode;
      op = exp->elts[pc + 1].opcode;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
        return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
      else if (op == BINOP_ADD)
      else if (op == BINOP_ADD)
        arg2 = value_add (arg1, arg2);
        arg2 = value_add (arg1, arg2);
      else if (op == BINOP_SUB)
      else if (op == BINOP_SUB)
        arg2 = value_sub (arg1, arg2);
        arg2 = value_sub (arg1, arg2);
      else
      else
        arg2 = value_binop (arg1, arg2, op);
        arg2 = value_binop (arg1, arg2, op);
      return value_assign (arg1, arg2);
      return value_assign (arg1, arg2);
 
 
    case BINOP_ADD:
    case BINOP_ADD:
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      else
      else
        return value_add (arg1, arg2);
        return value_add (arg1, arg2);
 
 
    case BINOP_SUB:
    case BINOP_SUB:
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      else
      else
        return value_sub (arg1, arg2);
        return value_sub (arg1, arg2);
 
 
    case BINOP_MUL:
    case BINOP_MUL:
    case BINOP_DIV:
    case BINOP_DIV:
    case BINOP_REM:
    case BINOP_REM:
    case BINOP_MOD:
    case BINOP_MOD:
    case BINOP_LSH:
    case BINOP_LSH:
    case BINOP_RSH:
    case BINOP_RSH:
    case BINOP_BITWISE_AND:
    case BINOP_BITWISE_AND:
    case BINOP_BITWISE_IOR:
    case BINOP_BITWISE_IOR:
    case BINOP_BITWISE_XOR:
    case BINOP_BITWISE_XOR:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      else if (noside == EVAL_AVOID_SIDE_EFFECTS
      else if (noside == EVAL_AVOID_SIDE_EFFECTS
               && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
               && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
        return value_zero (VALUE_TYPE (arg1), not_lval);
        return value_zero (VALUE_TYPE (arg1), not_lval);
      else
      else
        return value_binop (arg1, arg2, op);
        return value_binop (arg1, arg2, op);
 
 
    case BINOP_RANGE:
    case BINOP_RANGE:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      error ("':' operator used in invalid context");
      error ("':' operator used in invalid context");
 
 
    case BINOP_SUBSCRIPT:
    case BINOP_SUBSCRIPT:
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        return value_x_binop (arg1, arg2, op, OP_NULL, noside);
      else
      else
        {
        {
          /* If the user attempts to subscript something that is not an
          /* If the user attempts to subscript something that is not an
             array or pointer type (like a plain int variable for example),
             array or pointer type (like a plain int variable for example),
             then report this as an error. */
             then report this as an error. */
 
 
          COERCE_REF (arg1);
          COERCE_REF (arg1);
          type = check_typedef (VALUE_TYPE (arg1));
          type = check_typedef (VALUE_TYPE (arg1));
          if (TYPE_CODE (type) != TYPE_CODE_ARRAY
          if (TYPE_CODE (type) != TYPE_CODE_ARRAY
              && TYPE_CODE (type) != TYPE_CODE_PTR)
              && TYPE_CODE (type) != TYPE_CODE_PTR)
            {
            {
              if (TYPE_NAME (type))
              if (TYPE_NAME (type))
                error ("cannot subscript something of type `%s'",
                error ("cannot subscript something of type `%s'",
                       TYPE_NAME (type));
                       TYPE_NAME (type));
              else
              else
                error ("cannot subscript requested type");
                error ("cannot subscript requested type");
            }
            }
 
 
          if (noside == EVAL_AVOID_SIDE_EFFECTS)
          if (noside == EVAL_AVOID_SIDE_EFFECTS)
            return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
            return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
          else
          else
            return value_subscript (arg1, arg2);
            return value_subscript (arg1, arg2);
        }
        }
 
 
    case BINOP_IN:
    case BINOP_IN:
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      return value_in (arg1, arg2);
      return value_in (arg1, arg2);
 
 
    case MULTI_SUBSCRIPT:
    case MULTI_SUBSCRIPT:
      (*pos) += 2;
      (*pos) += 2;
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      while (nargs-- > 0)
      while (nargs-- > 0)
        {
        {
          arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
          arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
          /* FIXME:  EVAL_SKIP handling may not be correct. */
          /* FIXME:  EVAL_SKIP handling may not be correct. */
          if (noside == EVAL_SKIP)
          if (noside == EVAL_SKIP)
            {
            {
              if (nargs > 0)
              if (nargs > 0)
                {
                {
                  continue;
                  continue;
                }
                }
              else
              else
                {
                {
                  goto nosideret;
                  goto nosideret;
                }
                }
            }
            }
          /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
          /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
          if (noside == EVAL_AVOID_SIDE_EFFECTS)
          if (noside == EVAL_AVOID_SIDE_EFFECTS)
            {
            {
              /* If the user attempts to subscript something that has no target
              /* If the user attempts to subscript something that has no target
                 type (like a plain int variable for example), then report this
                 type (like a plain int variable for example), then report this
                 as an error. */
                 as an error. */
 
 
              type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
              type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
              if (type != NULL)
              if (type != NULL)
                {
                {
                  arg1 = value_zero (type, VALUE_LVAL (arg1));
                  arg1 = value_zero (type, VALUE_LVAL (arg1));
                  noside = EVAL_SKIP;
                  noside = EVAL_SKIP;
                  continue;
                  continue;
                }
                }
              else
              else
                {
                {
                  error ("cannot subscript something of type `%s'",
                  error ("cannot subscript something of type `%s'",
                         TYPE_NAME (VALUE_TYPE (arg1)));
                         TYPE_NAME (VALUE_TYPE (arg1)));
                }
                }
            }
            }
 
 
          if (binop_user_defined_p (op, arg1, arg2))
          if (binop_user_defined_p (op, arg1, arg2))
            {
            {
              arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
              arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
            }
            }
          else
          else
            {
            {
              arg1 = value_subscript (arg1, arg2);
              arg1 = value_subscript (arg1, arg2);
            }
            }
        }
        }
      return (arg1);
      return (arg1);
 
 
    multi_f77_subscript:
    multi_f77_subscript:
      {
      {
        int subscript_array[MAX_FORTRAN_DIMS + 1];      /* 1-based array of
        int subscript_array[MAX_FORTRAN_DIMS + 1];      /* 1-based array of
                                                           subscripts, max == 7 */
                                                           subscripts, max == 7 */
        int array_size_array[MAX_FORTRAN_DIMS + 1];
        int array_size_array[MAX_FORTRAN_DIMS + 1];
        int ndimensions = 1, i;
        int ndimensions = 1, i;
        struct type *tmp_type;
        struct type *tmp_type;
        int offset_item;        /* The array offset where the item lives */
        int offset_item;        /* The array offset where the item lives */
 
 
        if (nargs > MAX_FORTRAN_DIMS)
        if (nargs > MAX_FORTRAN_DIMS)
          error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
          error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
 
 
        tmp_type = check_typedef (VALUE_TYPE (arg1));
        tmp_type = check_typedef (VALUE_TYPE (arg1));
        ndimensions = calc_f77_array_dims (type);
        ndimensions = calc_f77_array_dims (type);
 
 
        if (nargs != ndimensions)
        if (nargs != ndimensions)
          error ("Wrong number of subscripts");
          error ("Wrong number of subscripts");
 
 
        /* Now that we know we have a legal array subscript expression
        /* Now that we know we have a legal array subscript expression
           let us actually find out where this element exists in the array. */
           let us actually find out where this element exists in the array. */
 
 
        offset_item = 0;
        offset_item = 0;
        for (i = 1; i <= nargs; i++)
        for (i = 1; i <= nargs; i++)
          {
          {
            /* Evaluate each subscript, It must be a legal integer in F77 */
            /* Evaluate each subscript, It must be a legal integer in F77 */
            arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
            arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 
 
            /* Fill in the subscript and array size arrays */
            /* Fill in the subscript and array size arrays */
 
 
            subscript_array[i] = value_as_long (arg2);
            subscript_array[i] = value_as_long (arg2);
 
 
            retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
            retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
            if (retcode == BOUND_FETCH_ERROR)
            if (retcode == BOUND_FETCH_ERROR)
              error ("Cannot obtain dynamic upper bound");
              error ("Cannot obtain dynamic upper bound");
 
 
            retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
            retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
            if (retcode == BOUND_FETCH_ERROR)
            if (retcode == BOUND_FETCH_ERROR)
              error ("Cannot obtain dynamic lower bound");
              error ("Cannot obtain dynamic lower bound");
 
 
            array_size_array[i] = upper - lower + 1;
            array_size_array[i] = upper - lower + 1;
 
 
            /* Zero-normalize subscripts so that offsetting will work. */
            /* Zero-normalize subscripts so that offsetting will work. */
 
 
            subscript_array[i] -= lower;
            subscript_array[i] -= lower;
 
 
            /* If we are at the bottom of a multidimensional
            /* If we are at the bottom of a multidimensional
               array type then keep a ptr to the last ARRAY
               array type then keep a ptr to the last ARRAY
               type around for use when calling value_subscript()
               type around for use when calling value_subscript()
               below. This is done because we pretend to value_subscript
               below. This is done because we pretend to value_subscript
               that we actually have a one-dimensional array
               that we actually have a one-dimensional array
               of base element type that we apply a simple
               of base element type that we apply a simple
               offset to. */
               offset to. */
 
 
            if (i < nargs)
            if (i < nargs)
              tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
              tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
          }
          }
 
 
        /* Now let us calculate the offset for this item */
        /* Now let us calculate the offset for this item */
 
 
        offset_item = subscript_array[ndimensions];
        offset_item = subscript_array[ndimensions];
 
 
        for (i = ndimensions - 1; i >= 1; i--)
        for (i = ndimensions - 1; i >= 1; i--)
          offset_item =
          offset_item =
            array_size_array[i] * offset_item + subscript_array[i];
            array_size_array[i] * offset_item + subscript_array[i];
 
 
        /* Construct a value node with the value of the offset */
        /* Construct a value node with the value of the offset */
 
 
        arg2 = value_from_longest (builtin_type_f_integer, offset_item);
        arg2 = value_from_longest (builtin_type_f_integer, offset_item);
 
 
        /* Let us now play a dirty trick: we will take arg1
        /* Let us now play a dirty trick: we will take arg1
           which is a value node pointing to the topmost level
           which is a value node pointing to the topmost level
           of the multidimensional array-set and pretend
           of the multidimensional array-set and pretend
           that it is actually a array of the final element
           that it is actually a array of the final element
           type, this will ensure that value_subscript()
           type, this will ensure that value_subscript()
           returns the correct type value */
           returns the correct type value */
 
 
        VALUE_TYPE (arg1) = tmp_type;
        VALUE_TYPE (arg1) = tmp_type;
        return value_ind (value_add (value_coerce_array (arg1), arg2));
        return value_ind (value_add (value_coerce_array (arg1), arg2));
      }
      }
 
 
    case BINOP_LOGICAL_AND:
    case BINOP_LOGICAL_AND:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        {
        {
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          goto nosideret;
          goto nosideret;
        }
        }
 
 
      oldpos = *pos;
      oldpos = *pos;
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      *pos = oldpos;
      *pos = oldpos;
 
 
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_logical_not (arg1);
          tem = value_logical_not (arg1);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
                                  (tem ? EVAL_SKIP : noside));
                                  (tem ? EVAL_SKIP : noside));
          return value_from_longest (LA_BOOL_TYPE,
          return value_from_longest (LA_BOOL_TYPE,
                             (LONGEST) (!tem && !value_logical_not (arg2)));
                             (LONGEST) (!tem && !value_logical_not (arg2)));
        }
        }
 
 
    case BINOP_LOGICAL_OR:
    case BINOP_LOGICAL_OR:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        {
        {
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          goto nosideret;
          goto nosideret;
        }
        }
 
 
      oldpos = *pos;
      oldpos = *pos;
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      *pos = oldpos;
      *pos = oldpos;
 
 
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_logical_not (arg1);
          tem = value_logical_not (arg1);
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
          arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
                                  (!tem ? EVAL_SKIP : noside));
                                  (!tem ? EVAL_SKIP : noside));
          return value_from_longest (LA_BOOL_TYPE,
          return value_from_longest (LA_BOOL_TYPE,
                             (LONGEST) (!tem || !value_logical_not (arg2)));
                             (LONGEST) (!tem || !value_logical_not (arg2)));
        }
        }
 
 
    case BINOP_EQUAL:
    case BINOP_EQUAL:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_equal (arg1, arg2);
          tem = value_equal (arg1, arg2);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
        }
        }
 
 
    case BINOP_NOTEQUAL:
    case BINOP_NOTEQUAL:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_equal (arg1, arg2);
          tem = value_equal (arg1, arg2);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
        }
        }
 
 
    case BINOP_LESS:
    case BINOP_LESS:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_less (arg1, arg2);
          tem = value_less (arg1, arg2);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
        }
        }
 
 
    case BINOP_GTR:
    case BINOP_GTR:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_less (arg2, arg1);
          tem = value_less (arg2, arg1);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
        }
        }
 
 
    case BINOP_GEQ:
    case BINOP_GEQ:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
          tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
        }
        }
 
 
    case BINOP_LEQ:
    case BINOP_LEQ:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (binop_user_defined_p (op, arg1, arg2))
      if (binop_user_defined_p (op, arg1, arg2))
        {
        {
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
          return value_x_binop (arg1, arg2, op, OP_NULL, noside);
        }
        }
      else
      else
        {
        {
          tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
          tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
          return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
        }
        }
 
 
    case BINOP_REPEAT:
    case BINOP_REPEAT:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      type = check_typedef (VALUE_TYPE (arg2));
      type = check_typedef (VALUE_TYPE (arg2));
      if (TYPE_CODE (type) != TYPE_CODE_INT)
      if (TYPE_CODE (type) != TYPE_CODE_INT)
        error ("Non-integral right operand for \"@\" operator.");
        error ("Non-integral right operand for \"@\" operator.");
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        {
        {
          return allocate_repeat_value (VALUE_TYPE (arg1),
          return allocate_repeat_value (VALUE_TYPE (arg1),
                                     longest_to_int (value_as_long (arg2)));
                                     longest_to_int (value_as_long (arg2)));
        }
        }
      else
      else
        return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
        return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
 
 
    case BINOP_COMMA:
    case BINOP_COMMA:
      evaluate_subexp (NULL_TYPE, exp, pos, noside);
      evaluate_subexp (NULL_TYPE, exp, pos, noside);
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
 
    case UNOP_NEG:
    case UNOP_NEG:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (unop_user_defined_p (op, arg1))
      if (unop_user_defined_p (op, arg1))
        return value_x_unop (arg1, op, noside);
        return value_x_unop (arg1, op, noside);
      else
      else
        return value_neg (arg1);
        return value_neg (arg1);
 
 
    case UNOP_COMPLEMENT:
    case UNOP_COMPLEMENT:
      /* C++: check for and handle destructor names.  */
      /* C++: check for and handle destructor names.  */
      op = exp->elts[*pos].opcode;
      op = exp->elts[*pos].opcode;
 
 
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
      if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
        return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
        return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
      else
      else
        return value_complement (arg1);
        return value_complement (arg1);
 
 
    case UNOP_LOGICAL_NOT:
    case UNOP_LOGICAL_NOT:
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (unop_user_defined_p (op, arg1))
      if (unop_user_defined_p (op, arg1))
        return value_x_unop (arg1, op, noside);
        return value_x_unop (arg1, op, noside);
      else
      else
        return value_from_longest (LA_BOOL_TYPE,
        return value_from_longest (LA_BOOL_TYPE,
                                   (LONGEST) value_logical_not (arg1));
                                   (LONGEST) value_logical_not (arg1));
 
 
    case UNOP_IND:
    case UNOP_IND:
      if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
      if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
        expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
        expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
      if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
          ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
          ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
           (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
           (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
        error ("Attempt to dereference pointer to member without an object");
        error ("Attempt to dereference pointer to member without an object");
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (unop_user_defined_p (op, arg1))
      if (unop_user_defined_p (op, arg1))
        return value_x_unop (arg1, op, noside);
        return value_x_unop (arg1, op, noside);
      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
        {
        {
          type = check_typedef (VALUE_TYPE (arg1));
          type = check_typedef (VALUE_TYPE (arg1));
          if (TYPE_CODE (type) == TYPE_CODE_PTR
          if (TYPE_CODE (type) == TYPE_CODE_PTR
              || TYPE_CODE (type) == TYPE_CODE_REF
              || TYPE_CODE (type) == TYPE_CODE_REF
          /* In C you can dereference an array to get the 1st elt.  */
          /* In C you can dereference an array to get the 1st elt.  */
              || TYPE_CODE (type) == TYPE_CODE_ARRAY
              || TYPE_CODE (type) == TYPE_CODE_ARRAY
            )
            )
            return value_zero (TYPE_TARGET_TYPE (type),
            return value_zero (TYPE_TARGET_TYPE (type),
                               lval_memory);
                               lval_memory);
          else if (TYPE_CODE (type) == TYPE_CODE_INT)
          else if (TYPE_CODE (type) == TYPE_CODE_INT)
            /* GDB allows dereferencing an int.  */
            /* GDB allows dereferencing an int.  */
            return value_zero (builtin_type_int, lval_memory);
            return value_zero (builtin_type_int, lval_memory);
          else
          else
            error ("Attempt to take contents of a non-pointer value.");
            error ("Attempt to take contents of a non-pointer value.");
        }
        }
      return value_ind (arg1);
      return value_ind (arg1);
 
 
    case UNOP_ADDR:
    case UNOP_ADDR:
      /* C++: check for and handle pointer to members.  */
      /* C++: check for and handle pointer to members.  */
 
 
      op = exp->elts[*pos].opcode;
      op = exp->elts[*pos].opcode;
 
 
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        {
        {
          if (op == OP_SCOPE)
          if (op == OP_SCOPE)
            {
            {
              int temm = longest_to_int (exp->elts[pc + 3].longconst);
              int temm = longest_to_int (exp->elts[pc + 3].longconst);
              (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
              (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
            }
            }
          else
          else
            evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
            evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          goto nosideret;
          goto nosideret;
        }
        }
      else
      else
        {
        {
          value_ptr retvalp = evaluate_subexp_for_address (exp, pos, noside);
          value_ptr retvalp = evaluate_subexp_for_address (exp, pos, noside);
          /* If HP aCC object, use bias for pointers to members */
          /* If HP aCC object, use bias for pointers to members */
          if (hp_som_som_object_present &&
          if (hp_som_som_object_present &&
              (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
              (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
              (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
            {
            {
              unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp);    /* forces evaluation */
              unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp);    /* forces evaluation */
              *ptr |= 0x20000000;       /* set 29th bit */
              *ptr |= 0x20000000;       /* set 29th bit */
            }
            }
          return retvalp;
          return retvalp;
        }
        }
 
 
    case UNOP_SIZEOF:
    case UNOP_SIZEOF:
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        {
        {
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
          goto nosideret;
          goto nosideret;
        }
        }
      return evaluate_subexp_for_sizeof (exp, pos);
      return evaluate_subexp_for_sizeof (exp, pos);
 
 
    case UNOP_CAST:
    case UNOP_CAST:
      (*pos) += 2;
      (*pos) += 2;
      type = exp->elts[pc + 1].type;
      type = exp->elts[pc + 1].type;
      arg1 = evaluate_subexp (type, exp, pos, noside);
      arg1 = evaluate_subexp (type, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (type != VALUE_TYPE (arg1))
      if (type != VALUE_TYPE (arg1))
        arg1 = value_cast (type, arg1);
        arg1 = value_cast (type, arg1);
      return arg1;
      return arg1;
 
 
    case UNOP_MEMVAL:
    case UNOP_MEMVAL:
      (*pos) += 2;
      (*pos) += 2;
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      if (noside == EVAL_SKIP)
      if (noside == EVAL_SKIP)
        goto nosideret;
        goto nosideret;
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        return value_zero (exp->elts[pc + 1].type, lval_memory);
        return value_zero (exp->elts[pc + 1].type, lval_memory);
      else
      else
        return value_at_lazy (exp->elts[pc + 1].type,
        return value_at_lazy (exp->elts[pc + 1].type,
                              value_as_pointer (arg1),
                              value_as_pointer (arg1),
                              NULL);
                              NULL);
 
 
    case UNOP_PREINCREMENT:
    case UNOP_PREINCREMENT:
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
        return arg1;
        return arg1;
      else if (unop_user_defined_p (op, arg1))
      else if (unop_user_defined_p (op, arg1))
        {
        {
          return value_x_unop (arg1, op, noside);
          return value_x_unop (arg1, op, noside);
        }
        }
      else
      else
        {
        {
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
                                                      (LONGEST) 1));
                                                      (LONGEST) 1));
          return value_assign (arg1, arg2);
          return value_assign (arg1, arg2);
        }
        }
 
 
    case UNOP_PREDECREMENT:
    case UNOP_PREDECREMENT:
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
        return arg1;
        return arg1;
      else if (unop_user_defined_p (op, arg1))
      else if (unop_user_defined_p (op, arg1))
        {
        {
          return value_x_unop (arg1, op, noside);
          return value_x_unop (arg1, op, noside);
        }
        }
      else
      else
        {
        {
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
                                                      (LONGEST) 1));
                                                      (LONGEST) 1));
          return value_assign (arg1, arg2);
          return value_assign (arg1, arg2);
        }
        }
 
 
    case UNOP_POSTINCREMENT:
    case UNOP_POSTINCREMENT:
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
        return arg1;
        return arg1;
      else if (unop_user_defined_p (op, arg1))
      else if (unop_user_defined_p (op, arg1))
        {
        {
          return value_x_unop (arg1, op, noside);
          return value_x_unop (arg1, op, noside);
        }
        }
      else
      else
        {
        {
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
          arg2 = value_add (arg1, value_from_longest (builtin_type_char,
                                                      (LONGEST) 1));
                                                      (LONGEST) 1));
          value_assign (arg1, arg2);
          value_assign (arg1, arg2);
          return arg1;
          return arg1;
        }
        }
 
 
    case UNOP_POSTDECREMENT:
    case UNOP_POSTDECREMENT:
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
        return arg1;
        return arg1;
      else if (unop_user_defined_p (op, arg1))
      else if (unop_user_defined_p (op, arg1))
        {
        {
          return value_x_unop (arg1, op, noside);
          return value_x_unop (arg1, op, noside);
        }
        }
      else
      else
        {
        {
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
          arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
                                                      (LONGEST) 1));
                                                      (LONGEST) 1));
          value_assign (arg1, arg2);
          value_assign (arg1, arg2);
          return arg1;
          return arg1;
        }
        }
 
 
    case OP_THIS:
    case OP_THIS:
      (*pos) += 1;
      (*pos) += 1;
      return value_of_this (1);
      return value_of_this (1);
 
 
    case OP_TYPE:
    case OP_TYPE:
      error ("Attempt to use a type name as an expression");
      error ("Attempt to use a type name as an expression");
 
 
    default:
    default:
      /* Removing this case and compiling with gcc -Wall reveals that
      /* Removing this case and compiling with gcc -Wall reveals that
         a lot of cases are hitting this case.  Some of these should
         a lot of cases are hitting this case.  Some of these should
         probably be removed from expression.h; others are legitimate
         probably be removed from expression.h; others are legitimate
         expressions which are (apparently) not fully implemented.
         expressions which are (apparently) not fully implemented.
 
 
         If there are any cases landing here which mean a user error,
         If there are any cases landing here which mean a user error,
         then they should be separate cases, with more descriptive
         then they should be separate cases, with more descriptive
         error messages.  */
         error messages.  */
 
 
      error ("\
      error ("\
GDB does not (yet) know how to evaluate that kind of expression");
GDB does not (yet) know how to evaluate that kind of expression");
    }
    }
 
 
nosideret:
nosideret:
  return value_from_longest (builtin_type_long, (LONGEST) 1);
  return value_from_longest (builtin_type_long, (LONGEST) 1);
}
}


/* Evaluate a subexpression of EXP, at index *POS,
/* Evaluate a subexpression of EXP, at index *POS,
   and return the address of that subexpression.
   and return the address of that subexpression.
   Advance *POS over the subexpression.
   Advance *POS over the subexpression.
   If the subexpression isn't an lvalue, get an error.
   If the subexpression isn't an lvalue, get an error.
   NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
   NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
   then only the type of the result need be correct.  */
   then only the type of the result need be correct.  */
 
 
static value_ptr
static value_ptr
evaluate_subexp_for_address (exp, pos, noside)
evaluate_subexp_for_address (exp, pos, noside)
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
     enum noside noside;
     enum noside noside;
{
{
  enum exp_opcode op;
  enum exp_opcode op;
  register int pc;
  register int pc;
  struct symbol *var;
  struct symbol *var;
 
 
  pc = (*pos);
  pc = (*pos);
  op = exp->elts[pc].opcode;
  op = exp->elts[pc].opcode;
 
 
  switch (op)
  switch (op)
    {
    {
    case UNOP_IND:
    case UNOP_IND:
      (*pos)++;
      (*pos)++;
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
 
    case UNOP_MEMVAL:
    case UNOP_MEMVAL:
      (*pos) += 3;
      (*pos) += 3;
      return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
      return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
                         evaluate_subexp (NULL_TYPE, exp, pos, noside));
                         evaluate_subexp (NULL_TYPE, exp, pos, noside));
 
 
    case OP_VAR_VALUE:
    case OP_VAR_VALUE:
      var = exp->elts[pc + 2].symbol;
      var = exp->elts[pc + 2].symbol;
 
 
      /* C++: The "address" of a reference should yield the address
      /* C++: The "address" of a reference should yield the address
       * of the object pointed to. Let value_addr() deal with it. */
       * of the object pointed to. Let value_addr() deal with it. */
      if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
      if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
        goto default_case;
        goto default_case;
 
 
      (*pos) += 4;
      (*pos) += 4;
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        {
        {
          struct type *type =
          struct type *type =
          lookup_pointer_type (SYMBOL_TYPE (var));
          lookup_pointer_type (SYMBOL_TYPE (var));
          enum address_class sym_class = SYMBOL_CLASS (var);
          enum address_class sym_class = SYMBOL_CLASS (var);
 
 
          if (sym_class == LOC_CONST
          if (sym_class == LOC_CONST
              || sym_class == LOC_CONST_BYTES
              || sym_class == LOC_CONST_BYTES
              || sym_class == LOC_REGISTER
              || sym_class == LOC_REGISTER
              || sym_class == LOC_REGPARM)
              || sym_class == LOC_REGPARM)
            error ("Attempt to take address of register or constant.");
            error ("Attempt to take address of register or constant.");
 
 
          return
          return
            value_zero (type, not_lval);
            value_zero (type, not_lval);
        }
        }
      else
      else
        return
        return
          locate_var_value
          locate_var_value
          (var,
          (var,
           block_innermost_frame (exp->elts[pc + 1].block));
           block_innermost_frame (exp->elts[pc + 1].block));
 
 
    default:
    default:
    default_case:
    default_case:
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
      if (noside == EVAL_AVOID_SIDE_EFFECTS)
        {
        {
          value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
          if (VALUE_LVAL (x) == lval_memory)
          if (VALUE_LVAL (x) == lval_memory)
            return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
            return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
                               not_lval);
                               not_lval);
          else
          else
            error ("Attempt to take address of non-lval");
            error ("Attempt to take address of non-lval");
        }
        }
      return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
      return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
    }
    }
}
}
 
 
/* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
/* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
   When used in contexts where arrays will be coerced anyway, this is
   When used in contexts where arrays will be coerced anyway, this is
   equivalent to `evaluate_subexp' but much faster because it avoids
   equivalent to `evaluate_subexp' but much faster because it avoids
   actually fetching array contents (perhaps obsolete now that we have
   actually fetching array contents (perhaps obsolete now that we have
   VALUE_LAZY).
   VALUE_LAZY).
 
 
   Note that we currently only do the coercion for C expressions, where
   Note that we currently only do the coercion for C expressions, where
   arrays are zero based and the coercion is correct.  For other languages,
   arrays are zero based and the coercion is correct.  For other languages,
   with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
   with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
   to decide if coercion is appropriate.
   to decide if coercion is appropriate.
 
 
 */
 */
 
 
value_ptr
value_ptr
evaluate_subexp_with_coercion (exp, pos, noside)
evaluate_subexp_with_coercion (exp, pos, noside)
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
     enum noside noside;
     enum noside noside;
{
{
  register enum exp_opcode op;
  register enum exp_opcode op;
  register int pc;
  register int pc;
  register value_ptr val;
  register value_ptr val;
  struct symbol *var;
  struct symbol *var;
 
 
  pc = (*pos);
  pc = (*pos);
  op = exp->elts[pc].opcode;
  op = exp->elts[pc].opcode;
 
 
  switch (op)
  switch (op)
    {
    {
    case OP_VAR_VALUE:
    case OP_VAR_VALUE:
      var = exp->elts[pc + 2].symbol;
      var = exp->elts[pc + 2].symbol;
      if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
      if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
          && CAST_IS_CONVERSION)
          && CAST_IS_CONVERSION)
        {
        {
          (*pos) += 4;
          (*pos) += 4;
          val =
          val =
            locate_var_value
            locate_var_value
            (var, block_innermost_frame (exp->elts[pc + 1].block));
            (var, block_innermost_frame (exp->elts[pc + 1].block));
          return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
          return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
                             val);
                             val);
        }
        }
      /* FALLTHROUGH */
      /* FALLTHROUGH */
 
 
    default:
    default:
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
      return evaluate_subexp (NULL_TYPE, exp, pos, noside);
    }
    }
}
}
 
 
/* Evaluate a subexpression of EXP, at index *POS,
/* Evaluate a subexpression of EXP, at index *POS,
   and return a value for the size of that subexpression.
   and return a value for the size of that subexpression.
   Advance *POS over the subexpression.  */
   Advance *POS over the subexpression.  */
 
 
static value_ptr
static value_ptr
evaluate_subexp_for_sizeof (exp, pos)
evaluate_subexp_for_sizeof (exp, pos)
     register struct expression *exp;
     register struct expression *exp;
     register int *pos;
     register int *pos;
{
{
  enum exp_opcode op;
  enum exp_opcode op;
  register int pc;
  register int pc;
  struct type *type;
  struct type *type;
  value_ptr val;
  value_ptr val;
 
 
  pc = (*pos);
  pc = (*pos);
  op = exp->elts[pc].opcode;
  op = exp->elts[pc].opcode;
 
 
  switch (op)
  switch (op)
    {
    {
      /* This case is handled specially
      /* This case is handled specially
         so that we avoid creating a value for the result type.
         so that we avoid creating a value for the result type.
         If the result type is very big, it's desirable not to
         If the result type is very big, it's desirable not to
         create a value unnecessarily.  */
         create a value unnecessarily.  */
    case UNOP_IND:
    case UNOP_IND:
      (*pos)++;
      (*pos)++;
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      type = check_typedef (VALUE_TYPE (val));
      type = check_typedef (VALUE_TYPE (val));
      if (TYPE_CODE (type) != TYPE_CODE_PTR
      if (TYPE_CODE (type) != TYPE_CODE_PTR
          && TYPE_CODE (type) != TYPE_CODE_REF
          && TYPE_CODE (type) != TYPE_CODE_REF
          && TYPE_CODE (type) != TYPE_CODE_ARRAY)
          && TYPE_CODE (type) != TYPE_CODE_ARRAY)
        error ("Attempt to take contents of a non-pointer value.");
        error ("Attempt to take contents of a non-pointer value.");
      type = check_typedef (TYPE_TARGET_TYPE (type));
      type = check_typedef (TYPE_TARGET_TYPE (type));
      return value_from_longest (builtin_type_int, (LONGEST)
      return value_from_longest (builtin_type_int, (LONGEST)
                                 TYPE_LENGTH (type));
                                 TYPE_LENGTH (type));
 
 
    case UNOP_MEMVAL:
    case UNOP_MEMVAL:
      (*pos) += 3;
      (*pos) += 3;
      type = check_typedef (exp->elts[pc + 1].type);
      type = check_typedef (exp->elts[pc + 1].type);
      return value_from_longest (builtin_type_int,
      return value_from_longest (builtin_type_int,
                                 (LONGEST) TYPE_LENGTH (type));
                                 (LONGEST) TYPE_LENGTH (type));
 
 
    case OP_VAR_VALUE:
    case OP_VAR_VALUE:
      (*pos) += 4;
      (*pos) += 4;
      type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
      type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
      return
      return
        value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
        value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
 
 
    default:
    default:
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
      return value_from_longest (builtin_type_int,
      return value_from_longest (builtin_type_int,
                                 (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
                                 (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
    }
    }
}
}
 
 
/* Parse a type expression in the string [P..P+LENGTH). */
/* Parse a type expression in the string [P..P+LENGTH). */
 
 
struct type *
struct type *
parse_and_eval_type (p, length)
parse_and_eval_type (p, length)
     char *p;
     char *p;
     int length;
     int length;
{
{
  char *tmp = (char *) alloca (length + 4);
  char *tmp = (char *) alloca (length + 4);
  struct expression *expr;
  struct expression *expr;
  tmp[0] = '(';
  tmp[0] = '(';
  memcpy (tmp + 1, p, length);
  memcpy (tmp + 1, p, length);
  tmp[length + 1] = ')';
  tmp[length + 1] = ')';
  tmp[length + 2] = '0';
  tmp[length + 2] = '0';
  tmp[length + 3] = '\0';
  tmp[length + 3] = '\0';
  expr = parse_expression (tmp);
  expr = parse_expression (tmp);
  if (expr->elts[0].opcode != UNOP_CAST)
  if (expr->elts[0].opcode != UNOP_CAST)
    error ("Internal error in eval_type.");
    error ("Internal error in eval_type.");
  return expr->elts[1].type;
  return expr->elts[1].type;
}
}
 
 
int
int
calc_f77_array_dims (array_type)
calc_f77_array_dims (array_type)
     struct type *array_type;
     struct type *array_type;
{
{
  int ndimen = 1;
  int ndimen = 1;
  struct type *tmp_type;
  struct type *tmp_type;
 
 
  if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
  if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
    error ("Can't get dimensions for a non-array type");
    error ("Can't get dimensions for a non-array type");
 
 
  tmp_type = array_type;
  tmp_type = array_type;
 
 
  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
    {
    {
      if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
      if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
        ++ndimen;
        ++ndimen;
    }
    }
  return ndimen;
  return ndimen;
}
}
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.