+Wed Feb 1 12:23:57 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * ch-exp.y (value_string_element, string_primitive_value,
+ start_element, left_element, right_element, slice_size,
+ lower_element, upper_element, first_element): Removed.
+ (value_string_slice, value_array_slice): Replaced by ...
+ (slice): New non-terminal, with working slice support.
+ (primitive_value_lparen, rparen): New non-terminals.
+ (maybe_tuple_elements): New non-terminal, to allow empty tuples.
+ (idtokentab): Added "up".
+
+ * value.h (COERCE_VARYING_ARRAY): New macro.
+ * valarith.c (value_subscript): Use it.
+ * valops.c (value_cast): Likewise. Also, do nothing if already
+ correct type, and allow converting from/to range to/from scalar.
+
+ * valops.c, value.h (varying_to_slice, value_slice): New functions.
+ * eval.c (OP_ARRAY): Add cast for array element.
+ * expression.h (TERNOP_SLICE, TERNOP_SLICE_COUNT): New exp_opcodes.
+ * valops.c (chill_varying_type): Moved function frp, here ...
+ * gdbtypes.c (chill_varying_type), gdbtypes.h: ... to here.
+ * parse.c (length_of_subexp, prefixify_subexp): Add support
+ for TERNOP_SLICE, TERNOP_SLICE_COUNT.
+ * expprint.c (print_subexp, dump_expression): Likewise.
+ * eval.c (evaluate_subexp): Likewise.
+
+ * eval.c (evaluate_subexp case MULTI_SUBSCRIPT): Don't call
+ value_x_binop on a Chill varying string.
+
Tue Jan 31 13:51:53 1995 Jim Kingdon (kingdon@lioth.cygnus.com)
* config/m68k/monitor.mt,
%type <voidval> value_name
%type <voidval> literal
%type <voidval> tuple
-%type <voidval> value_string_element
-%type <voidval> value_string_slice
-%type <voidval> value_array_slice
+%type <voidval> slice
%type <voidval> expression_conversion
%type <voidval> value_procedure_call
%type <voidval> value_built_in_routine_call
%type <voidval> value_enumeration_name
%type <voidval> value_do_with_name
%type <voidval> value_receive_name
-%type <voidval> string_primitive_value
-%type <voidval> start_element
-%type <voidval> left_element
-%type <voidval> right_element
-%type <voidval> slice_size
%type <voidval> expression_list
-%type <voidval> lower_element
-%type <voidval> upper_element
-%type <voidval> first_element
%type <tval> mode_argument
%type <voidval> upper_lower_argument
%type <voidval> length_argument
%type <voidval> buffer_location
%type <voidval> single_assignment_action
%type <tsym> mode_name
+%type <lval> rparen
%%
/* Z.200, 5.2.1 */
-primitive_value :
- access_name
- | primitive_value '('
+primitive_value_lparen: primitive_value '('
/* This is to save the value of arglist_len
being accumulated for each dimension. */
{ start_arglist (); }
- expression_list ')'
+ ;
+
+rparen : ')'
+ { $$ = end_arglist (); }
+ ;
+
+primitive_value :
+ access_name
+ | primitive_value_lparen expression_list rparen
{
write_exp_elt_opcode (MULTI_SUBSCRIPT);
- write_exp_elt_longcst ((LONGEST) end_arglist ());
+ write_exp_elt_longcst ($3);
write_exp_elt_opcode (MULTI_SUBSCRIPT);
}
| primitive_value FIELD_NAME
{
$$ = 0; /* FIXME */
}
- | value_string_element
- {
- $$ = 0; /* FIXME */
- }
- | value_string_slice
- {
- $$ = 0; /* FIXME */
- }
- | value_array_slice
+ | slice
{
$$ = 0; /* FIXME */
}
}
;
+maybe_tuple_elements : tuple_elements
+ | /* EMPTY */
+ ;
+
tuple : '['
{ start_arglist (); }
- tuple_elements ']'
+ maybe_tuple_elements ']'
{
write_exp_elt_opcode (OP_ARRAY);
write_exp_elt_longcst ((LONGEST) 0);
|
mode_name '['
{ start_arglist (); }
- tuple_elements ']'
+ maybe_tuple_elements ']'
{
write_exp_elt_opcode (OP_ARRAY);
write_exp_elt_longcst ((LONGEST) 0);
/* Z.200, 5.2.6 */
-value_string_element: string_primitive_value '(' start_element ')'
- {
- $$ = 0; /* FIXME */
- }
- ;
-
-/* Z.200, 5.2.7 */
-
-value_string_slice: string_primitive_value '(' left_element ':' right_element ')'
- {
- $$ = 0; /* FIXME */
- }
- | string_primitive_value '(' start_element UP slice_size ')'
- {
- $$ = 0; /* FIXME */
- }
- ;
-
-/* Z.200, 5.2.9 */
-value_array_slice: primitive_value '(' lower_element ':' upper_element ')'
+slice: primitive_value_lparen expression ':' expression rparen
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (TERNOP_SLICE);
}
- | primitive_value '(' first_element UP slice_size ')'
+ | primitive_value_lparen expression UP expression rparen
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (TERNOP_SLICE_COUNT);
}
;
value_enumeration_name : FIXME_12 { $$ = 0; }
value_do_with_name : FIXME_13 { $$ = 0; }
value_receive_name : FIXME_14 { $$ = 0; }
-string_primitive_value : FIXME_15 { $$ = 0; }
-start_element : FIXME_16 { $$ = 0; }
-left_element : FIXME_17 { $$ = 0; }
-right_element : FIXME_18 { $$ = 0; }
-slice_size : FIXME_19 { $$ = 0; }
-lower_element : FIXME_20 { $$ = 0; }
-upper_element : FIXME_21 { $$ = 0; }
-first_element : FIXME_22 { $$ = 0; }
boolean_expression : FIXME_26 { $$ = 0; }
case_selector_list : FIXME_27 { $$ = 0; }
subexpression : FIXME_28 { $$ = 0; }
{ "and", LOGAND },
{ "in", IN },
{ "or", LOGIOR },
+ { "up", UP },
{ "null", EMPTINESS_LITERAL }
};
{
value_ptr rec = allocate_value (expect_type);
int fieldno = 0;
- memset (VALUE_CONTENTS_RAW (rec), '\0',
- TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
+ memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
for (tem = 0; tem < nargs; tem++)
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
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);
+ memset (valaddr, '\0', TYPE_LENGTH (expect_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)
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. */
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
}
}
- if (binop_user_defined_p (op, arg1, arg2))
+ if (binop_user_defined_p (op, arg1, arg2)
+ && ! chill_varying_type (VALUE_TYPE (arg1)))
{
arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
}
/* Definitions for expressions stored in reversed prefix form, for GDB.
- Copyright 1986, 1989, 1992 Free Software Foundation, Inc.
+ Copyright 1986, 1989, 1992, 1994 Free Software Foundation, Inc.
This file is part of GDB.
/* BINOP_... operate on two values computed by following subexpressions,
replacing them by one result value. They take no immediate arguments. */
+
BINOP_ADD, /* + */
BINOP_SUB, /* - */
BINOP_MUL, /* * */
BINOP_SUBSCRIPT, /* x[y] */
BINOP_EXP, /* Exponentiation */
-/* C++. */
+ /* C++. */
+
BINOP_MIN, /* <? */
BINOP_MAX, /* >? */
BINOP_SCOPE, /* :: */
/* STRUCTOP_MEMBER is used for pointer-to-member constructs.
X . * Y translates into X STRUCTOP_MEMBER Y. */
STRUCTOP_MEMBER,
+
/* STRUCTOP_MPTR is used for pointer-to-member constructs
when X is a pointer instead of an aggregate. */
STRUCTOP_MPTR,
-/* end of C++. */
+
+ /* end of C++. */
/* For Modula-2 integer division DIV */
BINOP_INTDIV,
Then comes another BINOP_ASSIGN_MODIFY,
making three exp_elements in total. */
- /* Modula-2 standard (binary) procedures*/
+ /* Modula-2 standard (binary) procedures */
BINOP_VAL,
BINOP_INCL,
BINOP_EXCL,
+ /* Concatenate two operands, such as character strings or bitstrings.
+ If the first operand is a integer expression, then it means concatenate
+ the second operand with itself that many times. */
+ BINOP_CONCAT,
+
+ /* For Chill and Pascal. */
+ BINOP_IN, /* Returns 1 iff ARG1 IN ARG2. */
+
/* This must be the highest BINOP_ value, for expprint.c. */
BINOP_END,
-/* Operates on three values computed by following subexpressions. */
+ /* Operates on three values computed by following subexpressions. */
TERNOP_COND, /* ?: */
-/* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
- The dimensionality is encoded in the operator, like the number of
- function arguments in OP_FUNCALL, I.E. <OP><dimension><OP>.
- The value of the first following subexpression is subscripted
- by each of the next following subexpressions, one per dimension. */
+ /* A sub-string/sub-array. Chill syntax: OP1(OP2:OP3).
+ Return elements OP2 through OP3 of OP1. */
+ TERNOP_SLICE,
- MULTI_SUBSCRIPT,
-
-/* The OP_... series take immediate following arguments.
- After the arguments come another OP_... (the same one)
- so that the grouping can be recognized from the end. */
+ /* A sub-string/sub-array. Chill syntax: OP1(OP2 UP OP3).
+ Return OP3 elements of OP1, starting with element OP2. */
+ TERNOP_SLICE_COUNT,
-/* OP_LONG is followed by a type pointer in the next exp_element
- and the long constant value in the following exp_element.
- Then comes another OP_LONG.
- Thus, the operation occupies four exp_elements. */
+ /* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
+ The dimensionality is encoded in the operator, like the number of
+ function arguments in OP_FUNCALL, I.E. <OP><dimension><OP>.
+ The value of the first following subexpression is subscripted
+ by each of the next following subexpressions, one per dimension. */
+ MULTI_SUBSCRIPT,
+ /* For Fortran array subscripting (column major style). Like the
+ Modula operator, we find that the dimensionality is
+ encoded in the operator. This operator is distinct
+ from the above one because it uses column-major array
+ ordering not row-major. */
+ MULTI_F77_SUBSCRIPT,
+
+ /* The OP_... series take immediate following arguments.
+ After the arguments come another OP_... (the same one)
+ so that the grouping can be recognized from the end. */
+
+ /* OP_LONG is followed by a type pointer in the next exp_element
+ and the long constant value in the following exp_element.
+ Then comes another OP_LONG.
+ Thus, the operation occupies four exp_elements. */
OP_LONG,
-/* OP_DOUBLE is similar but takes a double constant instead of a long one. */
+
+ /* OP_DOUBLE is similar but takes a double constant instead of a long. */
OP_DOUBLE,
-/* OP_VAR_VALUE takes one struct symbol * in the following exp_element,
- followed by another OP_VAR_VALUE, making three exp_elements. */
+
+ /* OP_VAR_VALUE takes one struct block * in the following element,
+ and one struct symbol * in the following exp_element, followed by
+ another OP_VAR_VALUE, making four exp_elements. If the block is
+ non-NULL, evaluate the symbol relative to the innermost frame
+ executing in that block; if the block is NULL use the selected frame. */
OP_VAR_VALUE,
-/* OP_LAST is followed by an integer in the next exp_element.
- The integer is zero for the last value printed,
- or it is the absolute number of a history element.
- With another OP_LAST at the end, this makes three exp_elements. */
+
+ /* OP_LAST is followed by an integer in the next exp_element.
+ The integer is zero for the last value printed,
+ or it is the absolute number of a history element.
+ With another OP_LAST at the end, this makes three exp_elements. */
OP_LAST,
-/* OP_REGISTER is followed by an integer in the next exp_element.
- This is the number of a register to fetch (as an int).
- With another OP_REGISTER at the end, this makes three exp_elements. */
+
+ /* OP_REGISTER is followed by an integer in the next exp_element.
+ This is the number of a register to fetch (as an int).
+ With another OP_REGISTER at the end, this makes three exp_elements. */
OP_REGISTER,
-/* OP_INTERNALVAR is followed by an internalvar ptr in the next exp_element.
- With another OP_INTERNALVAR at the end, this makes three exp_elements. */
+
+ /* OP_INTERNALVAR is followed by an internalvar ptr in the next exp_element.
+ With another OP_INTERNALVAR at the end, this makes three exp_elements. */
OP_INTERNALVAR,
-/* OP_FUNCALL is followed by an integer in the next exp_element.
- The integer is the number of args to the function call.
- That many plus one values from following subexpressions
- are used, the first one being the function.
- The integer is followed by a repeat of OP_FUNCALL,
- making three exp_elements. */
+
+ /* OP_FUNCALL is followed by an integer in the next exp_element.
+ The integer is the number of args to the function call.
+ That many plus one values from following subexpressions
+ are used, the first one being the function.
+ The integer is followed by a repeat of OP_FUNCALL,
+ making three exp_elements. */
OP_FUNCALL,
-/* OP_STRING represents a string constant.
- Its format is the same as that of a STRUCTOP, but the string
- data is just made into a string constant when the operation
- is executed. */
+
+ /* This is EXACTLY like OP_FUNCALL but is semantically different.
+ In F77, array subscript expressions, substring expressions
+ and function calls are all exactly the same syntactically. They may
+ only be dismabiguated at runtime. Thus this operator, which
+ indicates that we have found something of the form <name> ( <stuff> ) */
+ OP_F77_UNDETERMINED_ARGLIST,
+
+ /* The following OP is a special one, it introduces a F77 complex
+ literal. It is followed by exactly two args that are doubles. */
+ OP_F77_LITERAL_COMPLEX,
+
+ /* The following OP introduces a F77 substring operator.
+ It should have a string type and two integer types that follow
+ indicating the "from" and "to" for the substring. */
+ OP_F77_SUBSTR,
+
+ /* OP_STRING represents a string constant.
+ Its format is the same as that of a STRUCTOP, but the string
+ data is just made into a string constant when the operation
+ is executed. */
OP_STRING,
-/* UNOP_CAST is followed by a type pointer in the next exp_element.
- With another UNOP_CAST at the end, this makes three exp_elements.
- It casts the value of the following subexpression. */
+ /* OP_BITSTRING represents a packed bitstring constant.
+ Its format is the same as that of a STRUCTOP, but the bitstring
+ data is just made into a bitstring constant when the operation
+ is executed. */
+ OP_BITSTRING,
+
+ /* OP_ARRAY creates an array constant out of the following subexpressions.
+ It is followed by two exp_elements, the first containing an integer
+ that is the lower bound of the array and the second containing another
+ integer that is the upper bound of the array. The second integer is
+ followed by a repeat of OP_ARRAY, making four exp_elements total.
+ The bounds are used to compute the number of following subexpressions
+ to consume, as well as setting the bounds in the created array constant.
+ The type of the elements is taken from the type of the first subexp,
+ and they must all match. */
+ OP_ARRAY,
+
+ /* UNOP_CAST is followed by a type pointer in the next exp_element.
+ With another UNOP_CAST at the end, this makes three exp_elements.
+ It casts the value of the following subexpression. */
UNOP_CAST,
-/* UNOP_MEMVAL is followed by a type pointer in the next exp_element
- With another UNOP_MEMVAL at the end, this makes three exp_elements.
- It casts the contents of the word addressed by the value of the
- following subexpression. */
+
+ /* UNOP_MEMVAL is followed by a type pointer in the next exp_element
+ With another UNOP_MEMVAL at the end, this makes three exp_elements.
+ It casts the contents of the word addressed by the value of the
+ following subexpression. */
UNOP_MEMVAL,
-/* UNOP_... operate on one value from a following subexpression
- and replace it with a result. They take no immediate arguments. */
+
+ /* UNOP_... operate on one value from a following subexpression
+ and replace it with a result. They take no immediate arguments. */
+
UNOP_NEG, /* Unary - */
UNOP_LOGICAL_NOT, /* Unary ! */
UNOP_COMPLEMENT, /* Unary ~ */
OP_BOOL, /* Modula-2 builtin BOOLEAN type */
OP_M2_STRING, /* Modula-2 string constants */
-/* STRUCTOP_... operate on a value from a following subexpression
- by extracting a structure component specified by a string
- that appears in the following exp_elements (as many as needed).
- STRUCTOP_STRUCT is used for "." and STRUCTOP_PTR for "->".
- They differ only in the error message given in case the value is
- not suitable or the structure component specified is not found.
+ /* STRUCTOP_... operate on a value from a following subexpression
+ by extracting a structure component specified by a string
+ that appears in the following exp_elements (as many as needed).
+ STRUCTOP_STRUCT is used for "." and STRUCTOP_PTR for "->".
+ They differ only in the error message given in case the value is
+ not suitable or the structure component specified is not found.
+
+ The length of the string follows the opcode, followed by
+ BYTES_TO_EXP_ELEM(length) elements containing the data of the
+ string, followed by the length again and the opcode again. */
- The length of the string follows in the next exp_element,
- (after the string), followed by another STRUCTOP_... code. */
STRUCTOP_STRUCT,
STRUCTOP_PTR,
-/* C++ */
+ /* C++ */
/* OP_THIS is just a placeholder for the class instance variable.
It just comes in a tight (OP_THIS, OP_THIS) pair. */
OP_THIS,
a string, which, of course, is variable length. */
OP_SCOPE,
+ /* Used to represent named structure field values in brace initializers
+ (or tuples as they are called in Chill).
+ The gcc C syntax is NAME:VALUE or .NAME=VALUE, the Chill syntax is
+ .NAME:VALUE. Multiple labels (as in the Chill syntax
+ .NAME1,.NAME2:VALUE) is represented as if it were
+ .NAME1:(.NAME2:VALUE) (though that is not valid Chill syntax).
+
+ The NAME is represented as for STRUCTOP_STRUCT; VALUE follows. */
+ OP_LABELED,
+
/* OP_TYPE is for parsing types, and used with the "ptype" command
so we can look up types that are qualified by scope, either with
the GDB "::" operator, or the Modula-2 '.' operator. */
struct symbol *symbol;
LONGEST longconst;
double doubleconst;
+ /* Really sizeof (union exp_element) characters (or less for the last
+ element of a string). */
char string;
struct type *type;
struct internalvar *internalvar;
+ struct block *block;
};
struct expression
union exp_element elts[1];
};
+/* Macros for converting between number of expression elements and bytes
+ to store that many expression elements. */
+
+#define EXP_ELEM_TO_BYTES(elements) \
+ ((elements) * sizeof (union exp_element))
+#define BYTES_TO_EXP_ELEM(bytes) \
+ (((bytes) + sizeof (union exp_element) - 1) / sizeof (union exp_element))
+
/* From parse.c */
-extern struct expression *
-parse_expression PARAMS ((char *));
+extern struct expression *parse_expression PARAMS ((char *));
-extern struct expression *
-parse_exp_1 PARAMS ((char **, struct block *, int));
+extern struct expression *parse_exp_1 PARAMS ((char **, struct block *, int));
/* The innermost context required by the stack and register variables
we've encountered so far. To use this, set it to NULL, then call
/* From expprint.c */
-extern void
-print_expression PARAMS ((struct expression *, FILE *));
+extern void print_expression PARAMS ((struct expression *, GDB_FILE *));
-extern char *
-op_string PARAMS ((enum exp_opcode));
+extern char *op_string PARAMS ((enum exp_opcode));
/* To enable dumping of all parsed expressions in a human readable
form, define DEBUG_EXPRESSIONS. This is a compile time constant
enough to include by default. */
#ifdef DEBUG_EXPRESSIONS
-extern void
-dump_expression PARAMS ((struct expression *, FILE *, char *));
+extern void dump_expression PARAMS ((struct expression *, GDB_FILE *, char *));
#define DUMP_EXPRESSION(exp,file,note) dump_expression ((exp), (file), (note))
#else
#define DUMP_EXPRESSION(exp,file,note) /* Null expansion */
&& TYPE_CODE (TYPE_TARGET_TYPE (t)) != TYPE_CODE_VOID);
}
+/* Chill varying string and arrays are represented as follows:
+
+ struct { int __var_length; ELEMENT_TYPE[MAX_SIZE] __var_data};
+
+ Return true if TYPE is such a Chill varying type. */
+
+int
+chill_varying_type (type)
+ struct type *type;
+{
+ if (TYPE_CODE (type) != TYPE_CODE_STRUCT
+ || TYPE_NFIELDS (type) != 2
+ || strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0)
+ return 0;
+ return 1;
+}
+
#if MAINTENANCE_CMDS
static void
extern struct type *f77_create_literal_complex_type PARAMS ((struct type *,
struct type *));
+extern int chill_varying_type PARAMS ((struct type*));
+
extern struct type *
lookup_unsigned_typename PARAMS ((char *));
break;
case TERNOP_COND:
+ case TERNOP_SLICE:
+ case TERNOP_SLICE_COUNT:
args = 3;
break;
break;
case TERNOP_COND:
+ case TERNOP_SLICE:
+ case TERNOP_SLICE_COUNT:
args = 3;
break;
register enum type_code code2;
register int scalar;
+ if (VALUE_TYPE (arg2) == type)
+ return arg2;
+
+ COERCE_VARYING_ARRAY (arg2);
+
/* Coerce arrays but not enums. Enums will work as-is
and coercing them would cause an infinite recursion. */
if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ENUM)
code2 = TYPE_CODE_INT;
scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
- || code2 == TYPE_CODE_ENUM);
+ || code2 == TYPE_CODE_ENUM || code2 == TYPE_CODE_RANGE);
if ( code1 == TYPE_CODE_STRUCT
&& code2 == TYPE_CODE_STRUCT
}
if (code1 == TYPE_CODE_FLT && scalar)
return value_from_double (type, value_as_double (arg2));
- else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM)
+ else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM
+ || code1 == TYPE_CODE_RANGE)
&& (scalar || code2 == TYPE_CODE_PTR))
return value_from_longest (type, value_as_long (arg2));
else if (TYPE_LENGTH (type) == TYPE_LENGTH (VALUE_TYPE (arg2)))
VALUE_TYPE (arg2) = type;
return arg2;
}
+ else if (chill_varying_type (type))
+ {
+ struct type *range1, *range2, *eltype1, *eltype2;
+ value_ptr val;
+ int count1, count2;
+ char *valaddr, *valaddr_data;
+ if (code2 == TYPE_CODE_BITSTRING)
+ error ("not implemented: converting bitstring to varying type");
+ if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
+ || (eltype1 = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)),
+ eltype2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2)),
+ (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
+ /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
+ error ("Invalid conversion to varying type");
+ range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
+ range2 = TYPE_FIELD_TYPE (VALUE_TYPE (arg2), 0);
+ count1 = TYPE_HIGH_BOUND (range1) - TYPE_LOW_BOUND (range1) + 1;
+ count2 = TYPE_HIGH_BOUND (range2) - TYPE_LOW_BOUND (range2) + 1;
+ if (count2 > count1)
+ error ("target varying type is too small");
+ val = allocate_value (type);
+ valaddr = VALUE_CONTENTS_RAW (val);
+ valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
+ /* Set val's __var_length field to count2. */
+ store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
+ count2);
+ /* Set the __var_data field to count2 elements copied from arg2. */
+ memcpy (valaddr_data, VALUE_CONTENTS (arg2),
+ count2 * TYPE_LENGTH (eltype2));
+ /* Zero the rest of the __var_data field of val. */
+ memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
+ (count1 - count2) * TYPE_LENGTH (eltype2));
+ return val;
+ }
else if (VALUE_LVAL (arg2) == lval_memory)
{
return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2));
VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
return arg2;
}
- if (VALUE_REPEATED (arg1)
- || TYPE_CODE (type) == TYPE_CODE_ARRAY)
+ if (current_language->c_style_arrays
+ && (VALUE_REPEATED (arg1)
+ || TYPE_CODE (type) == TYPE_CODE_ARRAY))
return value_coerce_array (arg1);
if (TYPE_CODE (type) == TYPE_CODE_FUNC)
return value_coerce_function (arg1);
arg = value_cast (builtin_type_unsigned_int, arg);
#if 1 /* FIXME: This is only a temporary patch. -fnf */
- if (VALUE_REPEATED (arg)
- || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)
+ if (current_language->c_style_arrays
+ && (VALUE_REPEATED (arg)
+ || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY))
arg = value_coerce_array (arg);
if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)
arg = value_coerce_function (arg);
int len;
{
value_ptr val;
- struct type *rangetype;
- struct type *stringtype;
+ struct type *rangetype = create_range_type ((struct type *) NULL,
+ builtin_type_int, 0, len - 1);
+ struct type *stringtype
+ = create_string_type ((struct type *) NULL, rangetype);
CORE_ADDR addr;
+ if (current_language->c_style_arrays == 0)
+ {
+ val = allocate_value (stringtype);
+ memcpy (VALUE_CONTENTS_RAW (val), ptr, len);
+ return val;
+ }
+
+
/* Allocate space to store the string in the inferior, and then
copy LEN bytes from PTR in gdb to that address in the inferior. */
addr = allocate_space_in_inferior (len);
write_memory (addr, ptr, len);
- /* Create the string type and set up a string value to be evaluated
- lazily. */
-
- rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
- 0, len - 1);
- stringtype = create_string_type ((struct type *) NULL, rangetype);
val = value_at_lazy (stringtype, addr);
return (val);
}
return val;
}
+/* Create a slice (sub-string, sub-array) of ARRAY, that is LENGTH elements
+ long, starting at LOWBOUND. The result has the same lower bound as
+ the original ARRAY. */
+
+value_ptr
+value_slice (array, lowbound, length)
+ value_ptr array;
+ int lowbound, length;
+{
+ if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_BITSTRING)
+ error ("not implemented - bitstring slice");
+ if (TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_ARRAY
+ && TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_STRING)
+ error ("cannot take slice of non-array");
+ else
+ {
+ struct type *slice_range_type, *slice_type;
+ value_ptr slice;
+ struct type *range_type = TYPE_FIELD_TYPE (VALUE_TYPE (array), 0);
+ struct type *element_type = TYPE_TARGET_TYPE (VALUE_TYPE (array));
+ int lowerbound = TYPE_LOW_BOUND (range_type);
+ int upperbound = TYPE_HIGH_BOUND (range_type);
+ int offset = (lowbound - lowerbound) * TYPE_LENGTH (element_type);
+ if (lowbound < lowerbound || length < 0
+ || lowbound + length - 1 > upperbound)
+ error ("slice out of range");
+ slice_range_type = create_range_type ((struct type*) NULL,
+ TYPE_TARGET_TYPE (range_type),
+ lowerbound,
+ lowerbound + length - 1);
+ slice_type = create_array_type ((struct type*) NULL, element_type,
+ slice_range_type);
+ TYPE_CODE (slice_type) = TYPE_CODE (VALUE_TYPE (array));
+ slice = allocate_value (slice_type);
+ if (VALUE_LAZY (array))
+ VALUE_LAZY (slice) = 1;
+ else
+ memcpy (VALUE_CONTENTS (slice), VALUE_CONTENTS (array) + offset,
+ TYPE_LENGTH (slice_type));
+ if (VALUE_LVAL (array) == lval_internalvar)
+ VALUE_LVAL (slice) = lval_internalvar_component;
+ else
+ VALUE_LVAL (slice) = VALUE_LVAL (array);
+ VALUE_ADDRESS (slice) = VALUE_ADDRESS (array);
+ VALUE_OFFSET (slice) = VALUE_OFFSET (array) + offset;
+ return slice;
+ }
+}
+
+/* Assuming chill_varying_type (VARRAY) is true, return an equivalent
+ value as a fixed-length array. */
+
+value_ptr
+varying_to_slice (varray)
+ value_ptr varray;
+{
+ struct type *vtype = VALUE_TYPE (varray);
+ LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
+ VALUE_CONTENTS (varray)
+ + TYPE_FIELD_BITPOS (vtype, 0) / 8);
+ return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length);
+}
+
/* Create a value for a substring. We copy data into a local
(NOT inferior's memory) buffer, and then set up an array value.
#define COERCE_ARRAY(arg) \
{ COERCE_REF(arg); \
- if (VALUE_REPEATED (arg) \
- || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY) \
+ if (current_language->c_style_arrays \
+ && (VALUE_REPEATED (arg) \
+ || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)) \
arg = value_coerce_array (arg); \
if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC) \
arg = value_coerce_function (arg); \
arg = value_cast (builtin_type_unsigned_int, arg); \
}
+#define COERCE_VARYING_ARRAY(arg) \
+{ if (chill_varying_type (VALUE_TYPE (arg))) arg = varying_to_slice (arg); }
+
/* If ARG is an enum, convert it to an integer. */
#define COERCE_ENUM(arg) \
/* From valops.c */
+extern value_ptr varying_to_slice PARAMS ((value_ptr));
+
+extern value_ptr value_slice PARAMS ((value_ptr, int, int));
+
extern value_ptr call_function_by_hand PARAMS ((value_ptr, int, value_ptr *));
extern value_ptr f77_value_literal_complex PARAMS ((value_ptr, value_ptr, int));
projects / external / binutils.git / commitdiff