/* Evaluate expressions for GDB.
- Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994
+ Copyright 1986, 87, 89, 91, 92, 93, 94, 95, 96, 97, 1998
Free Software Foundation, Inc.
This file is part of GDB.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
#include "defs.h"
-#include <string.h>
+#include "gdb_string.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "value.h"
#include "frame.h"
#include "demangle.h"
#include "language.h" /* For CAST_IS_CONVERSION */
-#include "f-lang.h" /* for array bound stuff */
+#include "f-lang.h" /* for array bound stuff */
-/* Values of NOSIDE argument to eval_subexp. */
+/* Defined in symtab.c */
+extern int hp_som_som_object_present;
+
+/* This is defined in valops.c */
+extern int overload_resolution;
-enum noside
-{
- EVAL_NORMAL,
- EVAL_SKIP, /* Only effect is to increment pos. */
- EVAL_AVOID_SIDE_EFFECTS /* Don't modify any variables or
- call any functions. The value
- returned will have the correct
- type, and will have an
- approximately correct lvalue
- type (inaccuracy: anything that is
- listed as being in a register in
- the function in which it was
- declared will be lval_register). */
-};
/* Prototypes for local functions. */
static value_ptr evaluate_subexp_for_sizeof PARAMS ((struct expression *,
int *));
-static value_ptr evaluate_subexp_with_coercion PARAMS ((struct expression *,
- int *, enum noside));
-
static value_ptr evaluate_subexp_for_address PARAMS ((struct expression *,
int *, enum noside));
static value_ptr evaluate_subexp PARAMS ((struct type *, struct expression *,
int *, enum noside));
+static char *get_label PARAMS ((struct expression *, int *));
+
+static value_ptr
+evaluate_struct_tuple PARAMS ((value_ptr, struct expression *, int *,
+ enum noside, int));
+
+static LONGEST
+init_array_element PARAMS ((value_ptr, value_ptr, struct expression *,
+ int *, enum noside, LONGEST, LONGEST));
+
+#ifdef __GNUC__
+inline
+#endif
+static value_ptr
+evaluate_subexp (expect_type, exp, pos, noside)
+ struct type *expect_type;
+ register struct expression *exp;
+ register int *pos;
+ enum noside noside;
+{
+ return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
+}
\f
/* Parse the string EXP as a C expression, evaluate it,
and return the result as a number. */
struct expression *expr = parse_expression (exp);
register CORE_ADDR addr;
register struct cleanup *old_chain =
- make_cleanup (free_current_contents, &expr);
+ make_cleanup ((make_cleanup_func) free_current_contents, &expr);
addr = value_as_pointer (evaluate_expression (expr));
do_cleanups (old_chain);
struct expression *expr = parse_exp_1 (expptr, (struct block *)0, 0);
register CORE_ADDR addr;
register struct cleanup *old_chain =
- make_cleanup (free_current_contents, &expr);
+ make_cleanup ((make_cleanup_func) free_current_contents, &expr);
addr = value_as_pointer (evaluate_expression (expr));
do_cleanups (old_chain);
struct expression *expr = parse_expression (exp);
register value_ptr val;
register struct cleanup *old_chain
- = make_cleanup (free_current_contents, &expr);
+ = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
val = evaluate_expression (expr);
do_cleanups (old_chain);
struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
register value_ptr val;
register struct cleanup *old_chain
- = make_cleanup (free_current_contents, &expr);
+ = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
val = evaluate_expression (expr);
do_cleanups (old_chain);
return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
}
-/* Helper function called by evaluate_subexp to initialize a field
- a structure from a tuple in Chill. This is recursive, to handle
- more than one field name labels.
+/* If the next expression is an OP_LABELED, skips past it,
+ returning the label. Otherwise, does nothing and returns NULL. */
- STRUCT_VAL is the structure value we are constructing.
- (*FIELDNOP) is the field to set, if there is no label.
- It is set to the field following this one.
- EXP, POS, and NOSIDE are as for evaluate_subexp.
+static char*
+get_label (exp, pos)
+ register struct expression *exp;
+ int *pos;
+{
+ if (exp->elts[*pos].opcode == OP_LABELED)
+ {
+ int pc = (*pos)++;
+ char *name = &exp->elts[pc + 2].string;
+ int tem = longest_to_int (exp->elts[pc + 1].longconst);
+ (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
+ return name;
+ }
+ else
+ return NULL;
+}
- This function does not handle variant records. FIXME */
+/* This function evaluates tupes (in Chill) or brace-initializers
+ (in C/C++) for structure types. */
static value_ptr
-evaluate_labeled_field_init (struct_val, fieldnop, exp, pos, noside)
+evaluate_struct_tuple (struct_val, exp, pos, noside, nargs)
value_ptr struct_val;
- int *fieldnop;
register struct expression *exp;
register int *pos;
enum noside noside;
+ int nargs;
{
- int fieldno = *fieldnop;
- value_ptr val;
- int bitpos, bitsize;
- char *addr;
- struct type *struct_type = VALUE_TYPE (struct_val);
- if (exp->elts[*pos].opcode == OP_LABELED)
+ struct type *struct_type = check_typedef (VALUE_TYPE (struct_val));
+ struct type *substruct_type = struct_type;
+ struct type *field_type;
+ int fieldno = -1;
+ int variantno = -1;
+ int subfieldno = -1;
+ while (--nargs >= 0)
{
- int pc = (*pos)++;
- char *name = &exp->elts[pc + 2].string;
- int tem = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
- for (fieldno = 0; ; fieldno++)
+ int pc = *pos;
+ value_ptr val = NULL;
+ int nlabels = 0;
+ int bitpos, bitsize;
+ char *addr;
+
+ /* Skip past the labels, and count them. */
+ while (get_label (exp, pos) != NULL)
+ nlabels++;
+
+ do
{
- if (fieldno >= TYPE_NFIELDS (struct_type))
- error ("there is no field named %s", name);
- if (STREQ (TYPE_FIELD_NAME (struct_type, fieldno), name))
- break;
+ char *label = get_label (exp, &pc);
+ if (label)
+ {
+ for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
+ fieldno++)
+ {
+ char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
+ if (field_name != NULL && STREQ (field_name, label))
+ {
+ variantno = -1;
+ subfieldno = fieldno;
+ substruct_type = struct_type;
+ goto found;
+ }
+ }
+ for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
+ fieldno++)
+ {
+ char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
+ field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
+ if ((field_name == 0 || *field_name == '\0')
+ && TYPE_CODE (field_type) == TYPE_CODE_UNION)
+ {
+ variantno = 0;
+ for (; variantno < TYPE_NFIELDS (field_type);
+ variantno++)
+ {
+ substruct_type
+ = TYPE_FIELD_TYPE (field_type, variantno);
+ if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
+ {
+ for (subfieldno = 0;
+ subfieldno < TYPE_NFIELDS (substruct_type);
+ subfieldno++)
+ {
+ if (STREQ (TYPE_FIELD_NAME (substruct_type,
+ subfieldno),
+ label))
+ {
+ goto found;
+ }
+ }
+ }
+ }
+ }
+ }
+ error ("there is no field named %s", label);
+ found:
+ ;
+ }
+ else
+ {
+ /* Unlabelled tuple element - go to next field. */
+ if (variantno >= 0)
+ {
+ subfieldno++;
+ if (subfieldno >= TYPE_NFIELDS (substruct_type))
+ {
+ variantno = -1;
+ substruct_type = struct_type;
+ }
+ }
+ if (variantno < 0)
+ {
+ fieldno++;
+ subfieldno = fieldno;
+ if (fieldno >= TYPE_NFIELDS (struct_type))
+ error ("too many initializers");
+ field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
+ if (TYPE_CODE (field_type) == TYPE_CODE_UNION
+ && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
+ error ("don't know which variant you want to set");
+ }
+ }
+
+ /* Here, struct_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
+ contains anonymous union fields that contain substruct fields.
+ The value fieldno is the index of the top-level (normal or
+ anonymous union) field in struct_field, while the value
+ subfieldno is the index of the actual real (named inner) field
+ in substruct_type. */
+
+ field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
+ if (val == 0)
+ val = evaluate_subexp (field_type, exp, pos, noside);
+
+ /* Now actually set the field in struct_val. */
+
+ /* Assign val to field fieldno. */
+ if (VALUE_TYPE (val) != field_type)
+ val = value_cast (field_type, val);
+
+ bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
+ bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
+ if (variantno >= 0)
+ bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
+ addr = VALUE_CONTENTS (struct_val) + bitpos / 8;
+ if (bitsize)
+ modify_field (addr, value_as_long (val),
+ bitpos % 8, bitsize);
+ else
+ memcpy (addr, VALUE_CONTENTS (val),
+ TYPE_LENGTH (VALUE_TYPE (val)));
+ } while (--nlabels > 0);
+ }
+ return struct_val;
+}
+
+/* Recursive helper function for setting elements of array tuples for Chill.
+ The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND);
+ the element value is ELEMENT;
+ EXP, POS and NOSIDE are as usual.
+ Evaluates index expresions and sets the specified element(s) of
+ ARRAY to ELEMENT.
+ Returns last index value. */
+
+static LONGEST
+init_array_element (array, element, exp, pos, noside, low_bound, high_bound)
+ value_ptr array, element;
+ register struct expression *exp;
+ register int *pos;
+ enum noside noside;
+ LONGEST low_bound, high_bound;
+{
+ LONGEST index;
+ int element_size = TYPE_LENGTH (VALUE_TYPE (element));
+ if (exp->elts[*pos].opcode == BINOP_COMMA)
+ {
+ (*pos)++;
+ init_array_element (array, element, exp, pos, noside,
+ low_bound, high_bound);
+ return init_array_element (array, element,
+ exp, pos, noside, low_bound, high_bound);
+ }
+ else if (exp->elts[*pos].opcode == BINOP_RANGE)
+ {
+ LONGEST low, high;
+ (*pos)++;
+ low = 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)
+ error ("tuple range index out of range");
+ for (index = low ; index <= high; index++)
+ {
+ memcpy (VALUE_CONTENTS_RAW (array)
+ + (index - low_bound) * element_size,
+ VALUE_CONTENTS (element), element_size);
}
- *fieldnop = fieldno;
- val = evaluate_labeled_field_init (struct_val, fieldnop,
- exp, pos, noside);
}
else
{
- fieldno = (*fieldnop)++;
- if (fieldno >= TYPE_NFIELDS (struct_type))
- error ("too many initializers");
- val = evaluate_subexp (TYPE_FIELD_TYPE (struct_type, fieldno),
- exp, pos, noside);
+ index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ if (index < low_bound || index > high_bound)
+ error ("tuple index out of range");
+ memcpy (VALUE_CONTENTS_RAW (array) + (index - low_bound) * element_size,
+ VALUE_CONTENTS (element), element_size);
}
-
- /* Assign val to field fieldno. */
- if (VALUE_TYPE (val) != TYPE_FIELD_TYPE (struct_type, fieldno))
- val = value_cast (TYPE_FIELD_TYPE (struct_type, fieldno), val);
-#if 1
- bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
- bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
- addr = VALUE_CONTENTS (struct_val);
- addr += bitpos / 8;
- if (bitsize)
- modify_field (addr, value_as_long (val),
- bitpos % 8, bitsize);
- else
- memcpy (addr, VALUE_CONTENTS (val),
- TYPE_LENGTH (VALUE_TYPE (val)));
-#else
- value_assign (value_primitive_field (struct_val, 0, fieldno, struct_type),
- val);
-#endif
- return val;
+ return index;
}
-static value_ptr
-evaluate_subexp (expect_type, exp, pos, noside)
+value_ptr
+evaluate_subexp_standard (expect_type, exp, pos, noside)
struct type *expect_type;
register struct expression *exp;
register int *pos;
struct type *type;
int nargs;
value_ptr *argvec;
- int tmp_pos, tmp1_pos;
- struct symbol *tmp_symbol;
int upper, lower, retcode;
int code;
- struct internalvar *var;
+ int ix;
+ long mem_offset;
+ struct symbol * sym;
+ struct type ** arg_types;
+ int save_pos1;
/* This expect_type crap should not be used for C. C expressions do
not have any notion of expected types, never has and (goddess
access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
case OP_REGISTER:
- (*pos) += 2;
- return value_of_register (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);
+ (*pos) += 2;
+ if (val == NULL)
+ error ("Value of register %s not available.", REGISTER_NAME (regno));
+ else
+ return val;
+ }
case OP_BOOL:
(*pos) += 2;
- if (current_language->la_language == language_fortran)
- return value_from_longest (builtin_type_f_logical_s2,
- exp->elts[pc + 1].longconst);
- else
- return value_from_longest (builtin_type_chill_bool,
+ return value_from_longest (LA_BOOL_TYPE,
exp->elts[pc + 1].longconst);
case OP_INTERNALVAR:
return value_string (&exp->elts[pc + 2].string, tem);
case OP_BITSTRING:
- error ("support for OP_BITSTRING unimplemented");
+ tem = longest_to_int (exp->elts[pc + 1].longconst);
+ (*pos)
+ += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ return value_bitstring (&exp->elts[pc + 2].string, tem);
break;
case OP_ARRAY:
tem2 = longest_to_int (exp->elts[pc + 1].longconst);
tem3 = longest_to_int (exp->elts[pc + 2].longconst);
nargs = tem3 - tem2 + 1;
+ type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
if (expect_type != NULL_TYPE && noside != EVAL_SKIP
- && TYPE_CODE (expect_type) == TYPE_CODE_STRUCT)
+ && TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
value_ptr rec = allocate_value (expect_type);
- int fieldno = 0;
- memset (VALUE_CONTENTS_RAW (rec), '\0',
- TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
- for (tem = 0; tem < nargs; tem++)
- evaluate_labeled_field_init (rec, &fieldno, exp, pos, noside);
- return rec;
+ memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (type));
+ return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
}
if (expect_type != NULL_TYPE && noside != EVAL_SKIP
- && TYPE_CODE (expect_type) == TYPE_CODE_ARRAY)
+ && TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
- struct type *range_type = TYPE_FIELD_TYPE (expect_type, 0);
- struct type *element_type = TYPE_TARGET_TYPE (expect_type);
- LONGEST low_bound = TYPE_FIELD_BITPOS (range_type, 0);
- LONGEST high_bound = TYPE_FIELD_BITPOS (range_type, 1);
- int element_size = TYPE_LENGTH (element_type);
- value_ptr rec = allocate_value (expect_type);
- if (nargs != (high_bound - low_bound + 1))
- error ("wrong number of initialiers for array type");
- for (tem = low_bound; tem <= high_bound; tem++)
+ struct type *range_type = TYPE_FIELD_TYPE (type, 0);
+ struct type *element_type = TYPE_TARGET_TYPE (type);
+ value_ptr array = allocate_value (expect_type);
+ int element_size = TYPE_LENGTH (check_typedef (element_type));
+ LONGEST low_bound, high_bound, index;
+ if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
{
- value_ptr element = evaluate_subexp (element_type,
- exp, pos, noside);
- memcpy (VALUE_CONTENTS_RAW (rec)
- + (tem - low_bound) * element_size,
- VALUE_CONTENTS (element),
- element_size);
+ low_bound = 0;
+ high_bound = (TYPE_LENGTH (type) / element_size) - 1;
}
- return rec;
+ index = low_bound;
+ memset (VALUE_CONTENTS_RAW (array), 0, TYPE_LENGTH (expect_type));
+ for (tem = nargs; --nargs >= 0; )
+ {
+ value_ptr element;
+ int index_pc = 0;
+ if (exp->elts[*pos].opcode == BINOP_RANGE)
+ {
+ index_pc = ++(*pos);
+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
+ }
+ element = evaluate_subexp (element_type, exp, pos, noside);
+ if (VALUE_TYPE (element) != element_type)
+ element = value_cast (element_type, element);
+ if (index_pc)
+ {
+ int continue_pc = *pos;
+ *pos = index_pc;
+ index = init_array_element (array, element, exp, pos, noside,
+ low_bound, high_bound);
+ *pos = continue_pc;
+ }
+ else
+ {
+ if (index > high_bound)
+ /* to avoid memory corruption */
+ error ("Too many array elements");
+ memcpy (VALUE_CONTENTS_RAW (array)
+ + (index - low_bound) * element_size,
+ VALUE_CONTENTS (element),
+ element_size);
+ }
+ index++;
+ }
+ return array;
}
if (expect_type != NULL_TYPE && noside != EVAL_SKIP
- && TYPE_CODE (expect_type) == TYPE_CODE_SET)
+ && TYPE_CODE (type) == TYPE_CODE_SET)
{
value_ptr set = allocate_value (expect_type);
- struct type *element_type = TYPE_INDEX_TYPE (expect_type);
- int low_bound = TYPE_LOW_BOUND (element_type);
- int high_bound = TYPE_HIGH_BOUND (element_type);
char *valaddr = VALUE_CONTENTS_RAW (set);
- memset (valaddr, '\0', TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
+ struct type *element_type = TYPE_INDEX_TYPE (type);
+ struct type *check_type = element_type;
+ LONGEST low_bound, high_bound;
+
+ /* get targettype of elementtype */
+ while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
+ TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
+ check_type = TYPE_TARGET_TYPE (check_type);
+
+ if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
+ error ("(power)set type with unknown size");
+ memset (valaddr, '\0', TYPE_LENGTH (type));
for (tem = 0; tem < nargs; tem++)
{
- value_ptr element_val = evaluate_subexp (element_type,
- exp, pos, noside);
- /* FIXME check that element_val has appropriate type. */
- LONGEST element = value_as_long (element_val);
- int bit_index;
- if (element < low_bound || element > high_bound)
+ LONGEST range_low, range_high;
+ struct type *range_low_type, *range_high_type;
+ value_ptr elem_val;
+ if (exp->elts[*pos].opcode == BINOP_RANGE)
+ {
+ (*pos)++;
+ elem_val = evaluate_subexp (element_type, exp, pos, noside);
+ range_low_type = VALUE_TYPE (elem_val);
+ range_low = value_as_long (elem_val);
+ elem_val = evaluate_subexp (element_type, exp, pos, noside);
+ range_high_type = VALUE_TYPE (elem_val);
+ range_high = value_as_long (elem_val);
+ }
+ else
+ {
+ elem_val = evaluate_subexp (element_type, exp, pos, noside);
+ range_low_type = range_high_type = VALUE_TYPE (elem_val);
+ range_low = range_high = value_as_long (elem_val);
+ }
+ /* check types of elements to avoid mixture of elements from
+ different types. Also check if type of element is "compatible"
+ with element type of powerset */
+ if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
+ range_low_type = TYPE_TARGET_TYPE (range_low_type);
+ if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
+ range_high_type = TYPE_TARGET_TYPE (range_high_type);
+ if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
+ (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
+ (range_low_type != range_high_type)))
+ /* different element modes */
+ error ("POWERSET tuple elements of different mode");
+ if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
+ (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
+ range_low_type != check_type))
+ error ("incompatible POWERSET tuple elements");
+ if (range_low > range_high)
+ {
+ warning ("empty POWERSET tuple range");
+ continue;
+ }
+ if (range_low < low_bound || range_high > high_bound)
error ("POWERSET tuple element out of range");
- element -= low_bound;
- bit_index = (unsigned) element % TARGET_CHAR_BIT;
- if (BITS_BIG_ENDIAN)
- bit_index = TARGET_CHAR_BIT - 1 - bit_index;
- valaddr [(unsigned) element / TARGET_CHAR_BIT] |= 1 << bit_index;
+ range_low -= low_bound;
+ range_high -= low_bound;
+ for ( ; range_low <= range_high; range_low++)
+ {
+ int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
+ if (BITS_BIG_ENDIAN)
+ bit_index = TARGET_CHAR_BIT - 1 - bit_index;
+ valaddr [(unsigned) range_low / TARGET_CHAR_BIT]
+ |= 1 << bit_index;
+ }
}
return set;
}
}
if (noside == EVAL_SKIP)
goto nosideret;
- if (current_language->la_language == language_fortran)
- /* For F77, we need to do special things to literal strings */
- return (f77_value_literal_string (tem2, tem3, argvec));
return value_array (tem2, tem3, argvec);
- break;
+
+ case TERNOP_SLICE:
+ {
+ value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ int lowbound
+ = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ int upper
+ = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ return value_slice (array, lowbound, upper - lowbound + 1);
+ }
+
+ case TERNOP_SLICE_COUNT:
+ {
+ value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ int lowbound
+ = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ int length
+ = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ return value_slice (array, lowbound, length);
+ }
case TERNOP_COND:
/* Skip third and second args to evaluate the first one. */
case OP_FUNCALL:
(*pos) += 2;
op = exp->elts[*pos].opcode;
+ nargs = longest_to_int (exp->elts[pc + 1].longconst);
+ /* Allocate arg vector, including space for the function to be
+ called in argvec[0] and a terminating NULL */
+ argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 3));
if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
{
LONGEST fnptr;
- nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
+ /* 1997-08-01 Currently we do not support function invocation
+ via pointers-to-methods with HP aCC. Pointer does not point
+ to the function, but possibly to some thunk. */
+ if (hp_som_som_object_present)
+ {
+ error ("Not implemented: function invocation through pointer to method with HP aCC");
+ }
+
+ nargs++;
/* First, evaluate the structure into arg2 */
pc2 = (*pos)++;
/* If one is virtual, then all are virtual. */
if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
- if (TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
+ if ((int) TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
{
value_ptr temp = value_ind (arg2);
arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
/* Hair for method invocations */
int tem2;
- nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
+ nargs++;
/* First, evaluate the structure into arg2 */
pc2 = (*pos)++;
tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
}
else
{
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- tem = 0;
+ /* Non-method function call */
+ save_pos1 = *pos;
+ argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
+ tem = 1;
+ type = VALUE_TYPE (argvec[0]);
+ if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
+ type = TYPE_TARGET_TYPE (type);
+ if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
+ {
+ for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
+ {
+ /* pai: FIXME This seems to be coercing arguments before
+ * overload resolution has been done! */
+ argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem-1),
+ exp, pos, noside);
+ }
+ }
}
- /* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL */
- argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
+
+ /* Evaluate arguments */
for (; tem <= nargs; tem++)
- /* Ensure that array expressions are coerced into pointer objects. */
- argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+ {
+ /* Ensure that array expressions are coerced into pointer objects. */
+ argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+ }
/* signal end of arglist */
argvec[tem] = 0;
{
int static_memfuncp;
value_ptr temp = arg2;
- char tstr[64];
-
- argvec[1] = arg2;
- argvec[0] = 0;
- strcpy(tstr, &exp->elts[pc2+2].string);
- if (!argvec[0])
- {
- temp = arg2;
- argvec[0] =
- value_struct_elt (&temp, argvec+1, tstr,
- &static_memfuncp,
- op == STRUCTOP_STRUCT
- ? "structure" : "structure pointer");
- }
- arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
- VALUE_ADDRESS (temp)+VALUE_OFFSET (temp));
- argvec[1] = arg2;
+ char tstr[256];
+ struct fn_field * fns_ptr;
+ int num_fns;
+ struct type * basetype;
+ int boffset;
+
+ /* Method invocation : stuff "this" as first parameter */
+ /* pai: this used to have lookup_pointer_type for some reason,
+ * but temp is already a pointer to the object */
+ argvec[1] = value_from_longest (VALUE_TYPE (temp),
+ VALUE_ADDRESS (temp)+VALUE_OFFSET (temp));
+ /* Name of method from expression */
+ strcpy(tstr, &exp->elts[pc2+2].string);
+
+ if (overload_resolution && (exp->language_defn->la_language == language_cplus))
+ {
+ /* Language is C++, do some overload resolution before evaluation */
+ value_ptr valp = NULL;
+
+ /* Prepare list of argument types for overload resolution */
+ arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
+ for (ix=1; ix <= nargs; ix++)
+ arg_types[ix-1] = VALUE_TYPE (argvec[ix]);
+
+ (void) find_overload_match (arg_types, nargs, tstr,
+ 1 /* method */, 0 /* strict match */,
+ arg2 /* the object */, NULL,
+ &valp, NULL, &static_memfuncp);
+
+
+ argvec[1] = arg2; /* the ``this'' pointer */
+ argvec[0] = valp; /* use the method found after overload resolution */
+ }
+ else /* Non-C++ case -- or no overload resolution */
+ {
+ temp = arg2;
+ argvec[0] = value_struct_elt (&temp, argvec+1, tstr,
+ &static_memfuncp,
+ op == STRUCTOP_STRUCT
+ ? "structure" : "structure pointer");
+ argvec[1] = arg2; /* the ``this'' pointer */
+ }
if (static_memfuncp)
{
argvec[1] = arg2;
argvec[0] = arg1;
}
+ else
+ {
+ /* Non-member function being called */
+
+ if (overload_resolution && (exp->language_defn->la_language == language_cplus))
+ {
+ /* Language is C++, do some overload resolution before evaluation */
+ struct symbol * symp;
+
+ /* Prepare list of argument types for overload resolution */
+ arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
+ for (ix=1; ix <= nargs; ix++)
+ arg_types[ix-1] = VALUE_TYPE (argvec[ix]);
+
+ (void) find_overload_match (arg_types, nargs, NULL /* no need for name */,
+ 0 /* not method */, 0 /* strict match */,
+ NULL, exp->elts[5].symbol /* the function */,
+ NULL, &symp, NULL);
+
+ /* Now fix the expression being evaluated */
+ exp->elts[5].symbol = symp;
+ argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
+ }
+ else
+ {
+ /* Not C++, or no overload resolution allowed */
+ /* nothing to be done; argvec already correctly set up */
+ }
+ }
+
+ do_call_it:
if (noside == EVAL_SKIP)
goto nosideret;
else
error ("Expression of type other than \"Function returning ...\" used as function");
}
+ if (argvec[0] == NULL)
+ error ("Cannot evaluate function -- may be inlined");
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 */
case OP_F77_UNDETERMINED_ARGLIST:
- tmp_pos = pc; /* Point to this instr */
-
/* Remember that in F77, functions, substring ops and
array subscript operations cannot be disambiguated
at parse time. We have made all array subscript operations,
substring operations as well as function calls come here
and we now have to discover what the heck this thing actually was.
- If it is an array, we massage it into a form that the
- MULTI_F77_SUBSCRIPT operator can deal with. If it is
- a function, we process just as if we got an OP_FUNCALL and
- for a subscring operation, we perform the appropriate
- substring operation. */
+ If it is a function, we process just as if we got an OP_FUNCALL. */
- /* First get the nargs and then jump all the way over the:
-
- OP_UNDETERMINED_ARGLIST
- nargs
- OP_UNDETERMINED_ARGLIST
-
- instruction sequence */
-
- nargs = longest_to_int (exp->elts[tmp_pos+1].longconst);
- tmp_pos += 3; /* size(op_funcall) == 3 elts */
-
- /* We will always have an OP_VAR_VALUE as the next opcode.
- The data stored after the OP_VAR_VALUE is the a pointer
- to the function/array/string symbol. We should now check and
- make sure that the symbols is an array and not a function.
- If it is an array type, we have hit a F77 subscript operation and
- we have to do some magic. If it is not an array, we check
- to see if we found a string here. If there is a string,
- we recursively evaluate and let OP_f77_SUBSTR deal with
- things. If there is no string, we know there is a function
- call at hand and change OP_FUNCALL_OR_SUBSCRIPT -> OP_FUNCALL.
- In all cases, we recursively evaluate. */
+ nargs = longest_to_int (exp->elts[pc+1].longconst);
+ (*pos) += 2;
/* First determine the type code we are dealing with. */
-
- switch (exp->elts[tmp_pos].opcode)
- {
- case OP_VAR_VALUE:
- tmp_pos += 1; /* To get to the symbol ptr */
- tmp_symbol = exp->elts[tmp_pos].symbol;
- code = TYPE_CODE (SYMBOL_TYPE (tmp_symbol));
- break;
-
- case OP_INTERNALVAR:
- tmp_pos += 1;
- var = exp->elts[tmp_pos].internalvar;
- code = TYPE_CODE(VALUE_TYPE(var->value));
- break;
-
- case OP_F77_UNDETERMINED_ARGLIST:
- /* Special case when you do stuff like print ARRAY(1,1)(3:4) */
- tmp1_pos = tmp_pos ;
- arg2 = evaluate_subexp (NULL_TYPE, exp, &tmp1_pos, noside);
- code =TYPE_CODE (VALUE_TYPE (arg2));
- break;
-
- default:
- error ("Cannot perform substring on this type");
- }
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ type = check_typedef (VALUE_TYPE (arg1));
+ code = TYPE_CODE (type);
switch (code)
{
- case TYPE_CODE_ARRAY:
- /* Transform this into what it really is: a MULTI_F77_SUBSCRIPT */
- tmp_pos = pc;
- exp->elts[tmp_pos].opcode = MULTI_F77_SUBSCRIPT;
- exp->elts[tmp_pos+2].opcode = MULTI_F77_SUBSCRIPT;
- break;
-
- case TYPE_CODE_LITERAL_STRING: /* When substring'ing internalvars */
+ case TYPE_CODE_ARRAY:
+ goto multi_f77_subscript;
+
case TYPE_CODE_STRING:
- tmp_pos = pc;
- exp->elts[tmp_pos].opcode = OP_F77_SUBSTR;
- exp->elts[tmp_pos+2].opcode = OP_F77_SUBSTR;
- break;
+ goto op_f77_substr;
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
- /* This is just a regular OP_FUNCALL, transform it
- and recursively evaluate */
- tmp_pos = pc; /* Point to OP_FUNCALL_OR_SUBSCRIPT */
- exp->elts[tmp_pos].opcode = OP_FUNCALL;
- exp->elts[tmp_pos+2].opcode = OP_FUNCALL;
- break;
+ /* It's a function call. */
+ /* Allocate arg vector, including space for the function to be
+ called in argvec[0] and a terminating NULL */
+ argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
+ argvec[0] = arg1;
+ tem = 1;
+ for (; tem <= nargs; tem++)
+ argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+ argvec[tem] = 0; /* signal end of arglist */
+ goto do_call_it;
default:
error ("Cannot perform substring on this type");
}
- /* Pretend like you never saw this expression */
- *pos -= 1;
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- return arg2;
-
- case OP_F77_SUBSTR:
+ op_f77_substr:
/* We have a substring operation on our hands here,
let us get the string we will be dealing with */
- (*pos) += 2;
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
-
/* Now evaluate the 'from' and 'to' */
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
- error ("Substring arguments must be of type integer");
+ if (nargs < 2)
+ return value_subscript (arg1, arg2);
arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (TYPE_CODE (VALUE_TYPE (arg3)) != TYPE_CODE_INT)
- error ("Substring arguments must be of type integer");
-
- tem2 = *((int *) VALUE_CONTENTS_RAW (arg2));
- tem3 = *((int *) VALUE_CONTENTS_RAW (arg3));
-
- if ((tem2 < 1) || (tem2 > tem3))
- error ("Bad 'from' value %d on substring operation", tem2);
-
- if ((tem3 < tem2) || (tem3 > (TYPE_LENGTH (VALUE_TYPE (arg1)))))
- error ("Bad 'to' value %d on substring operation", tem3);
-
if (noside == EVAL_SKIP)
goto nosideret;
- return f77_value_substring (arg1, tem2, tem3);
+ tem2 = value_as_long (arg2);
+ tem3 = value_as_long (arg3);
+
+ return value_slice (arg1, tem2, tem3 - tem2 + 1);
- case OP_F77_LITERAL_COMPLEX:
+ case OP_COMPLEX:
/* We have a complex number, There should be 2 floating
point numbers that compose it */
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- /* Complex*16 is the default size to create */
- return f77_value_literal_complex (arg1, arg2, 16);
+ return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
case STRUCTOP_STRUCT:
tem = longest_to_int (exp->elts[pc + 1].longconst);
case STRUCTOP_MEMBER:
arg1 = evaluate_subexp_for_address (exp, pos, noside);
+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+
+ /* With HP aCC, pointers to methods do not point to the function code */
+ if (hp_som_som_object_present &&
+ (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
+ (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
+ error ("Pointers to methods not supported with HP aCC"); /* 1997-08-19 */
+
+ mem_offset = value_as_long (arg2);
goto handle_pointer_to_member;
+
case STRUCTOP_MPTR:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- handle_pointer_to_member:
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+
+ /* With HP aCC, pointers to methods do not point to the function code */
+ if (hp_som_som_object_present &&
+ (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
+ (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
+ error ("Pointers to methods not supported with HP aCC"); /* 1997-08-19 */
+
+ mem_offset = value_as_long (arg2);
+
+handle_pointer_to_member:
+ /* HP aCC generates offsets that have bit #29 set; turn it off to get
+ a real offset to the member. */
+ if (hp_som_som_object_present)
+ {
+ if (!mem_offset) /* no bias -> really null */
+ error ("Attempted dereference of null pointer-to-member");
+ mem_offset &= ~0x20000000;
+ }
if (noside == EVAL_SKIP)
goto nosideret;
- if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_PTR)
+ type = check_typedef (VALUE_TYPE (arg2));
+ if (TYPE_CODE (type) != TYPE_CODE_PTR)
goto bad_pointer_to_member;
- type = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
+ type = check_typedef (TYPE_TARGET_TYPE (type));
if (TYPE_CODE (type) == TYPE_CODE_METHOD)
error ("not implemented: pointer-to-method in pointer-to-member construct");
if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
arg1);
arg3 = value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
- value_as_long (arg1) + value_as_long (arg2));
+ value_as_long (arg1) + mem_offset);
return value_ind (arg3);
- bad_pointer_to_member:
+bad_pointer_to_member:
error("non-pointer-to-member value used in pointer-to-member construct");
case BINOP_CONCAT:
if (noside == EVAL_SKIP)
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
else
return value_concat (arg1, arg2);
case BINOP_ASSIGN:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
+
+ /* Do special stuff for HP aCC pointers to members */
+ if (hp_som_som_object_present)
+ {
+ /* 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
+ sequence (thunk) in memory -- in any case it is *not* the address
+ of the function as it would be in a naive implementation. */
+ if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
+ (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD))
+ error ("Assignment to pointers to methods not implemented with HP aCC");
+
+ /* HP aCC pointers to data members require a constant bias */
+ if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
+ (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER))
+ {
+ unsigned int * ptr = (unsigned int *) VALUE_CONTENTS (arg2); /* forces evaluation */
+ *ptr |= 0x20000000; /* set 29th bit */
+ }
+ }
+
if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
return arg1;
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
else
return value_assign (arg1, arg2);
return arg1;
op = exp->elts[pc + 1].opcode;
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op);
+ return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
else if (op == BINOP_ADD)
arg2 = value_add (arg1, arg2);
else if (op == BINOP_SUB)
if (noside == EVAL_SKIP)
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
else
return value_add (arg1, arg2);
if (noside == EVAL_SKIP)
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
else
return value_sub (arg1, arg2);
if (noside == EVAL_SKIP)
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
else
if (noside == EVAL_AVOID_SIDE_EFFECTS
&& (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
else
return value_binop (arg1, arg2, op);
+ case BINOP_RANGE:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ error ("':' operator used in invalid context");
+
case BINOP_SUBSCRIPT:
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- /* If the user attempts to subscript something that has no target
- type (like a plain int variable for example), then report this
- as an error. */
-
- type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
- if (type)
- return value_zero (type, VALUE_LVAL (arg1));
- else
- error ("cannot subscript something of type `%s'",
- TYPE_NAME (VALUE_TYPE (arg1)));
- }
-
if (binop_user_defined_p (op, arg1, arg2))
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
else
- return value_subscript (arg1, arg2);
+ {
+ /* If the user attempts to subscript something that is not an
+ array or pointer type (like a plain int variable for example),
+ then report this as an error. */
+
+ COERCE_REF (arg1);
+ type = check_typedef (VALUE_TYPE (arg1));
+ if (TYPE_CODE (type) != TYPE_CODE_ARRAY
+ && TYPE_CODE (type) != TYPE_CODE_PTR)
+ {
+ if (TYPE_NAME (type))
+ error ("cannot subscript something of type `%s'",
+ TYPE_NAME (type));
+ else
+ error ("cannot subscript requested type");
+ }
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
+ else
+ return value_subscript (arg1, arg2);
+ }
case BINOP_IN:
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
type (like a plain int variable for example), then report this
as an error. */
- type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
+ type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
if (type != NULL)
{
arg1 = value_zero (type, VALUE_LVAL (arg1));
if (binop_user_defined_p (op, arg1, arg2))
{
- arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
+ arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
}
return (arg1);
- case MULTI_F77_SUBSCRIPT:
+ multi_f77_subscript:
{
int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of
subscripts, max == 7 */
int ndimensions=1,i;
struct type *tmp_type;
int offset_item; /* The array offset where the item lives */
- int fixed_subscript;
- (*pos) += 2;
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
-
if (nargs > MAX_FORTRAN_DIMS)
error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- ndimensions = calc_f77_array_dims (VALUE_TYPE (arg1));
+ tmp_type = check_typedef (VALUE_TYPE (arg1));
+ ndimensions = calc_f77_array_dims (type);
if (nargs != ndimensions)
error ("Wrong number of subscripts");
/* Now that we know we have a legal array subscript expression
let us actually find out where this element exists in the array. */
- tmp_type = VALUE_TYPE (arg1);
offset_item = 0;
for (i = 1; i <= nargs; i++)
{
/* Evaluate each subscript, It must be a legal integer in F77 */
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
- error ("Array subscripts must be of type integer");
-
/* Fill in the subscript and array size arrays */
- subscript_array[i] = (* (unsigned int *) VALUE_CONTENTS(arg2));
+ subscript_array[i] = value_as_long (arg2);
retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
if (retcode == BOUND_FETCH_ERROR)
offset to. */
if (i < nargs)
- tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
}
/* Now let us calculate the offset for this item */
returns the correct type value */
VALUE_TYPE (arg1) = tmp_type;
-
- arg1 = value_subscript (arg1, arg2);
- return arg1;
+ return value_ind (value_add (value_coerce_array (arg1), arg2));
}
case BINOP_LOGICAL_AND:
if (binop_user_defined_p (op, arg1, arg2))
{
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_logical_not (arg1);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
(tem ? EVAL_SKIP : noside));
- return value_from_longest (builtin_type_int,
+ return value_from_longest (LA_BOOL_TYPE,
(LONGEST) (!tem && !value_logical_not (arg2)));
}
if (binop_user_defined_p (op, arg1, arg2))
{
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_logical_not (arg1);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
(!tem ? EVAL_SKIP : noside));
- return value_from_longest (builtin_type_int,
+ return value_from_longest (LA_BOOL_TYPE,
(LONGEST) (!tem || !value_logical_not (arg2)));
}
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
{
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_equal (arg1, arg2);
- return value_from_longest (builtin_type_int, (LONGEST) tem);
+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
}
case BINOP_NOTEQUAL:
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
{
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_equal (arg1, arg2);
- return value_from_longest (builtin_type_int, (LONGEST) ! tem);
+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
}
case BINOP_LESS:
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
{
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_less (arg1, arg2);
- return value_from_longest (builtin_type_int, (LONGEST) tem);
+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
}
case BINOP_GTR:
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
{
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_less (arg2, arg1);
- return value_from_longest (builtin_type_int, (LONGEST) tem);
+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
}
case BINOP_GEQ:
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
{
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
- return value_from_longest (builtin_type_int, (LONGEST) tem);
+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
}
case BINOP_LEQ:
goto nosideret;
if (binop_user_defined_p (op, arg1, arg2))
{
- return value_x_binop (arg1, arg2, op, OP_NULL);
+ return value_x_binop (arg1, arg2, op, OP_NULL, noside);
}
else
{
tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
- return value_from_longest (builtin_type_int, (LONGEST) tem);
+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
}
case BINOP_REPEAT:
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
+ type = check_typedef (VALUE_TYPE (arg2));
+ if (TYPE_CODE (type) != TYPE_CODE_INT)
error ("Non-integral right operand for \"@\" operator.");
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return allocate_repeat_value (VALUE_TYPE (arg1),
- longest_to_int (value_as_long (arg2)));
+ {
+ return allocate_repeat_value (VALUE_TYPE (arg1),
+ longest_to_int (value_as_long (arg2)));
+ }
else
return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
if (noside == EVAL_SKIP)
goto nosideret;
if (unop_user_defined_p (op, arg1))
- return value_x_unop (arg1, op);
+ return value_x_unop (arg1, op, noside);
else
return value_neg (arg1);
if (noside == EVAL_SKIP)
goto nosideret;
if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
- return value_x_unop (arg1, UNOP_COMPLEMENT);
+ return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
else
return value_complement (arg1);
if (noside == EVAL_SKIP)
goto nosideret;
if (unop_user_defined_p (op, arg1))
- return value_x_unop (arg1, op);
+ return value_x_unop (arg1, op, noside);
else
- return value_from_longest (builtin_type_int,
+ return value_from_longest (LA_BOOL_TYPE,
(LONGEST) value_logical_not (arg1));
case UNOP_IND:
if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
- expect_type = TYPE_TARGET_TYPE (expect_type);
+ expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
arg1 = evaluate_subexp (expect_type, exp, pos, noside);
+ 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_MEMBER)))
+ error ("Attempt to dereference pointer to member without an object");
if (noside == EVAL_SKIP)
goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ if (unop_user_defined_p (op, arg1))
+ return value_x_unop (arg1, op, noside);
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR
- || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_REF
+ type = check_typedef (VALUE_TYPE (arg1));
+ if (TYPE_CODE (type) == TYPE_CODE_PTR
+ || TYPE_CODE (type) == TYPE_CODE_REF
/* In C you can dereference an array to get the 1st elt. */
- || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY
+ || TYPE_CODE (type) == TYPE_CODE_ARRAY
)
- return value_zero (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)),
+ return value_zero (TYPE_TARGET_TYPE (type),
lval_memory);
- else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_INT)
+ else if (TYPE_CODE (type) == TYPE_CODE_INT)
/* GDB allows dereferencing an int. */
return value_zero (builtin_type_int, lval_memory);
else
evaluate_subexp (expect_type, exp, pos, EVAL_SKIP);
goto nosideret;
}
-
- return evaluate_subexp_for_address (exp, pos, noside);
-
+ else
+ {
+ value_ptr retvalp = evaluate_subexp_for_address (exp, pos, noside);
+ /* If HP aCC object, use bias for pointers to members */
+ if (hp_som_som_object_present &&
+ (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
+ (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
+ {
+ unsigned int * ptr = (unsigned int *) VALUE_CONTENTS (retvalp); /* forces evaluation */
+ *ptr |= 0x20000000; /* set 29th bit */
+ }
+ return retvalp;
+ }
+
case UNOP_SIZEOF:
if (noside == EVAL_SKIP)
{
return value_zero (exp->elts[pc + 1].type, lval_memory);
else
return value_at_lazy (exp->elts[pc + 1].type,
- value_as_pointer (arg1));
+ value_as_pointer (arg1),
+ NULL);
case UNOP_PREINCREMENT:
arg1 = evaluate_subexp (expect_type, exp, pos, noside);
return arg1;
else if (unop_user_defined_p (op, arg1))
{
- return value_x_unop (arg1, op);
+ return value_x_unop (arg1, op, noside);
}
else
{
return arg1;
else if (unop_user_defined_p (op, arg1))
{
- return value_x_unop (arg1, op);
+ return value_x_unop (arg1, op, noside);
}
else
{
return arg1;
else if (unop_user_defined_p (op, arg1))
{
- return value_x_unop (arg1, op);
+ return value_x_unop (arg1, op, noside);
}
else
{
return arg1;
else if (unop_user_defined_p (op, arg1))
{
- return value_x_unop (arg1, op);
+ return value_x_unop (arg1, op, noside);
}
else
{
*/
-static value_ptr
+value_ptr
evaluate_subexp_with_coercion (exp, pos, noside)
register struct expression *exp;
register int *pos;
{
case OP_VAR_VALUE:
var = exp->elts[pc + 2].symbol;
- if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ARRAY
+ if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
&& CAST_IS_CONVERSION)
{
(*pos) += 4;
{
enum exp_opcode op;
register int pc;
+ struct type *type;
value_ptr val;
pc = (*pos);
case UNOP_IND:
(*pos)++;
val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+ type = check_typedef (VALUE_TYPE (val));
+ if (TYPE_CODE (type) != TYPE_CODE_PTR
+ && TYPE_CODE (type) != TYPE_CODE_REF
+ && TYPE_CODE (type) != TYPE_CODE_ARRAY)
+ error ("Attempt to take contents of a non-pointer value.");
+ type = check_typedef (TYPE_TARGET_TYPE (type));
return value_from_longest (builtin_type_int, (LONGEST)
- TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (val))));
+ TYPE_LENGTH (type));
case UNOP_MEMVAL:
(*pos) += 3;
- return value_from_longest (builtin_type_int,
- (LONGEST) TYPE_LENGTH (exp->elts[pc + 1].type));
+ type = check_typedef (exp->elts[pc + 1].type);
+ return value_from_longest (builtin_type_int,
+ (LONGEST) TYPE_LENGTH (type));
case OP_VAR_VALUE:
(*pos) += 4;
+ type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
return
- value_from_longest
- (builtin_type_int,
- (LONGEST) TYPE_LENGTH (SYMBOL_TYPE (exp->elts[pc + 2].symbol)));
+ value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
default:
val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
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)
++ndimen;
projects / deliverable / binutils-gdb.git / blobdiff