/* Evaluate expressions for GDB.
- Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994, 1995
+ Copyright 1986, 87, 89, 91, 92, 93, 94, 95, 96, 97, 1998
Free Software Foundation, Inc.
This file is part of GDB.
#include "demangle.h"
#include "language.h" /* For CAST_IS_CONVERSION */
#include "f-lang.h" /* for array bound stuff */
-/* start-sanitize-gm */
-#ifdef GENERAL_MAGIC_HACKS
-#include "magic.h"
-#endif /* GENERAL_MAGIC_HACKS */
-/* end-sanitize-gm */
+
+/* Defined in symtab.c */
+extern int hp_som_som_object_present;
+
+/* This is defined in valops.c */
+extern int overload_resolution;
+
/* Prototypes for local functions. */
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
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);
enum noside noside;
int nargs;
{
- struct type *struct_type = VALUE_TYPE (struct_val);
+ 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)
+ while (--nargs >= 0)
{
int pc = *pos;
value_ptr val = NULL;
field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
if (val == 0)
- val = evaluate_subexp (substruct_type, exp, pos, noside);
+ val = evaluate_subexp (field_type, exp, pos, noside);
/* Now actually set the field in struct_val. */
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);
+ }
+ }
+ else
+ {
+ 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);
+ }
+ return index;
+}
+
value_ptr
evaluate_subexp_standard (expect_type, exp, pos, noside)
struct type *expect_type;
value_ptr *argvec;
int upper, lower, retcode;
int code;
+ 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:
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);
- memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
+ 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);
+ struct type *range_type = TYPE_FIELD_TYPE (type, 0);
+ struct type *element_type = TYPE_TARGET_TYPE (type);
value_ptr array = 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++)
+ 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);
+ low_bound = 0;
+ high_bound = (TYPE_LENGTH (type) / element_size) - 1;
+ }
+ 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);
- memcpy (VALUE_CONTENTS_RAW (array)
- + (tem - low_bound) * element_size,
- VALUE_CONTENTS (element),
- element_size);
+ 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));
+ 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);
- 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;
}
= 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 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:
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:
/* First determine the type code we are dealing with. */
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- code = TYPE_CODE (VALUE_TYPE (arg1));
+ type = check_typedef (VALUE_TYPE (arg1));
+ code = TYPE_CODE (type);
switch (code)
{
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;
+ tem2 = value_as_long (arg2);
+ tem3 = value_as_long (arg3);
+
return value_slice (arg1, tem2, tem3 - tem2 + 1);
case OP_COMPLEX:
NULL, "structure pointer");
}
-/* start-sanitize-gm */
-#ifdef GENERAL_MAGIC_HACKS
- case STRUCTOP_FIELD:
- tem = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- {
- CORE_ADDR object = value_as_long (arg1);
- struct type *type = type_of_object (object);
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (lookup_struct_elt_type (type,
- &exp->elts[pc + 2].string,
- 0),
- lval_memory);
- else
- {
- value_ptr temp = value_from_longest (builtin_type_unsigned_long,
- baseptr_of_object (value_as_long(arg1)));
-
- VALUE_TYPE (temp) = type;
- return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
- NULL, "structure pointer");
- }
- }
-#endif /* GENERAL_MAGIC_HACKS */
-/* end-sanitize-gm */
-
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
{
if (nargs > MAX_FORTRAN_DIMS)
error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
-
- 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 */
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)
{
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
{
{
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);
projects / deliverable / binutils-gdb.git / blobdiff