/* Evaluate expressions for GDB.
- Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994
+ Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994, 1995
Free Software Foundation, Inc.
This file is part of GDB.
#include "frame.h"
#include "demangle.h"
#include "language.h" /* For CAST_IS_CONVERSION */
-#include "f-lang.h" /* for array bound stuff */
-
-/* Values of NOSIDE argument to eval_subexp. */
-
-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). */
-};
+#include "f-lang.h" /* for array bound stuff */
/* 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));
-
+#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. */
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.
+
+ 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.
+
+ This function does not handle variant records. FIXME */
+
static value_ptr
-evaluate_subexp (expect_type, exp, pos, noside)
+evaluate_labeled_field_init (struct_val, fieldnop, exp, pos, noside)
+ value_ptr struct_val;
+ int *fieldnop;
+ register struct expression *exp;
+ register int *pos;
+ enum noside noside;
+{
+ 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)
+ {
+ 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++)
+ {
+ if (fieldno >= TYPE_NFIELDS (struct_type))
+ error ("there is no field named %s", name);
+ if (STREQ (TYPE_FIELD_NAME (struct_type, fieldno), name))
+ break;
+ }
+ *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);
+ }
+
+ /* 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;
+}
+
+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;
+ /* This expect_type crap should not be used for C. C expressions do
+ not have any notion of expected types, never has and (goddess
+ willing) never will. The C++ code uses it for some twisted
+ purpose (I haven't investigated but I suspect it just the usual
+ combination of Stroustrup figuring out some crazy language
+ feature and Tiemann figuring out some crazier way to try to
+ implement it). CHILL has the tuple stuff; I don't know enough
+ about CHILL to know whether expected types is the way to do it.
+ FORTRAN I don't know. */
+ if (exp->language_defn->la_language != language_cplus
+ && exp->language_defn->la_language != language_chill)
+ expect_type = NULL_TYPE;
+
pc = (*pos)++;
op = exp->elts[pc].opcode;
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:
&& TYPE_CODE (expect_type) == TYPE_CODE_STRUCT)
{
value_ptr rec = allocate_value (expect_type);
- if (TYPE_NFIELDS (expect_type) != nargs)
- error ("wrong number of initialiers for structure type");
+ int fieldno = 0;
+ memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
for (tem = 0; tem < nargs; tem++)
- {
- struct type *field_type = TYPE_FIELD_TYPE (expect_type, tem);
- value_ptr field_val = evaluate_subexp (field_type,
- exp, pos, noside);
- int bitsize, bitpos;
- char *addr;
- if (VALUE_TYPE (field_val) != field_type)
- field_val = value_cast (field_type, field_val);
-#if 1
- bitsize = TYPE_FIELD_BITSIZE (expect_type, tem);
- bitpos = TYPE_FIELD_BITPOS (expect_type, tem);
- addr = VALUE_CONTENTS (rec);
- addr += bitpos / 8;
- if (bitsize)
- modify_field (addr, value_as_long (field_val),
- bitpos % 8, bitsize);
- else
- memcpy (addr, VALUE_CONTENTS (field_val),
- TYPE_LENGTH (VALUE_TYPE (field_val)));
-#else
- value_assign (value_primitive_field (rec, 0, tem, expect_type),
- field_val);
-#endif
- }
+ evaluate_labeled_field_init (rec, &fieldno, exp, pos, noside);
return rec;
}
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);
+ 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++)
{
value_ptr element = evaluate_subexp (element_type,
exp, pos, noside);
- memcpy (VALUE_CONTENTS_RAW (rec)
+ 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);
}
- return rec;
+ return array;
+ }
+
+ if (expect_type != NULL_TYPE && noside != EVAL_SKIP
+ && TYPE_CODE (expect_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));
+ 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)
+ 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;
+ }
+ return set;
}
argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
}
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));
+ 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. */
argvec[0] = arg1;
}
+ do_call_it:
+
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
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);
+ code = TYPE_CODE (VALUE_TYPE (arg1));
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)
if (noside == EVAL_SKIP)
goto nosideret;
- return f77_value_substring (arg1, tem2, tem3);
+ 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);
}
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));
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:
*/
-static value_ptr
+value_ptr
evaluate_subexp_with_coercion (exp, pos, noside)
register struct expression *exp;
register int *pos;
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