diff options
| -rw-r--r-- | gdb/ChangeLog | 29 | ||||
| -rw-r--r-- | gdb/ch-exp.y | 83 | ||||
| -rw-r--r-- | gdb/eval.c | 37 | ||||
| -rw-r--r-- | gdb/expression.h | 227 | ||||
| -rw-r--r-- | gdb/gdbtypes.c | 17 | ||||
| -rw-r--r-- | gdb/gdbtypes.h | 2 | ||||
| -rw-r--r-- | gdb/parse.c | 4 | ||||
| -rw-r--r-- | gdb/valops.c | 137 | ||||
| -rw-r--r-- | gdb/value.h | 12 |
9 files changed, 397 insertions, 151 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 091e021..60c7bac 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,32 @@ +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, diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y index 46f48da..8b76979 100644 --- a/gdb/ch-exp.y +++ b/gdb/ch-exp.y @@ -252,9 +252,7 @@ yyerror PARAMS ((char *)); %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 @@ -281,15 +279,7 @@ yyerror PARAMS ((char *)); %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 @@ -303,6 +293,7 @@ yyerror PARAMS ((char *)); %type <voidval> buffer_location %type <voidval> single_assignment_action %type <tsym> mode_name +%type <lval> rparen %% @@ -379,16 +370,22 @@ expression_list : expression /* 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 @@ -412,15 +409,7 @@ primitive_value : { $$ = 0; /* FIXME */ } - | value_string_element - { - $$ = 0; /* FIXME */ - } - | value_string_slice - { - $$ = 0; /* FIXME */ - } - | value_array_slice + | slice { $$ = 0; /* FIXME */ } @@ -561,9 +550,13 @@ tuple_elements : tuple_element } ; +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); @@ -573,7 +566,7 @@ tuple : '[' | mode_name '[' { start_arglist (); } - tuple_elements ']' + maybe_tuple_elements ']' { write_exp_elt_opcode (OP_ARRAY); write_exp_elt_longcst ((LONGEST) 0); @@ -589,33 +582,14 @@ tuple : '[' /* 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); } ; @@ -986,14 +960,6 @@ synonym_name : FIXME_11 { $$ = 0; } 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; } @@ -1764,6 +1730,7 @@ static const struct token idtokentab[] = { "and", LOGAND }, { "in", IN }, { "or", LOGIOR }, + { "up", UP }, { "null", EMPTINESS_LITERAL } }; @@ -365,8 +365,7 @@ evaluate_subexp (expect_type, exp, pos, noside) { 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; @@ -380,19 +379,21 @@ evaluate_subexp (expect_type, exp, pos, noside) 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 @@ -403,12 +404,11 @@ evaluate_subexp (expect_type, exp, pos, noside) 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) @@ -436,6 +436,26 @@ evaluate_subexp (expect_type, exp, pos, noside) 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); @@ -982,7 +1002,8 @@ evaluate_subexp (expect_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); } diff --git a/gdb/expression.h b/gdb/expression.h index 8c34642..d9c7bfe 100644 --- a/gdb/expression.h +++ b/gdb/expression.h @@ -1,5 +1,5 @@ /* 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. @@ -47,6 +47,7 @@ enum exp_opcode /* 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, /* * */ @@ -72,7 +73,8 @@ enum exp_opcode BINOP_SUBSCRIPT, /* x[y] */ BINOP_EXP, /* Exponentiation */ -/* C++. */ + /* C++. */ + BINOP_MIN, /* <? */ BINOP_MAX, /* >? */ BINOP_SCOPE, /* :: */ @@ -80,10 +82,12 @@ enum exp_opcode /* 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, @@ -94,76 +98,143 @@ enum exp_opcode 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 ~ */ @@ -191,19 +262,21 @@ enum exp_opcode 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, @@ -213,6 +286,16 @@ enum exp_opcode 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. */ @@ -225,9 +308,12 @@ union exp_element 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 @@ -237,13 +323,19 @@ 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 @@ -252,11 +344,9 @@ extern struct block *innermost_block; /* 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 @@ -264,8 +354,7 @@ op_string PARAMS ((enum exp_opcode)); 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 */ diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 9ec6666..cc76898 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1236,6 +1236,23 @@ can_dereference (t) && 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 diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index c3b5f31..3e26098 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -732,6 +732,8 @@ extern struct type *create_set_type PARAMS ((struct type *, struct type *)); 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 *)); diff --git a/gdb/parse.c b/gdb/parse.c index a6d9575..0defac0f 100644 --- a/gdb/parse.c +++ b/gdb/parse.c @@ -535,6 +535,8 @@ length_of_subexp (expr, endpos) break; case TERNOP_COND: + case TERNOP_SLICE: + case TERNOP_SLICE_COUNT: args = 3; break; @@ -677,6 +679,8 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg) break; case TERNOP_COND: + case TERNOP_SLICE: + case TERNOP_SLICE_COUNT: args = 3; break; diff --git a/gdb/valops.c b/gdb/valops.c index 880f872b..e5e5734 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -129,6 +129,11 @@ value_cast (type, arg2) 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) @@ -145,7 +150,7 @@ value_cast (type, arg2) 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 @@ -164,7 +169,8 @@ value_cast (type, arg2) } 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))) @@ -194,6 +200,40 @@ value_cast (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)); @@ -679,8 +719,9 @@ value_addr (arg1) 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); @@ -799,8 +840,9 @@ value_arg_coerce (arg) 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); @@ -1278,22 +1320,26 @@ value_string (ptr, len) 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); } @@ -2043,6 +2089,69 @@ f77_value_literal_string (lowbound, highbound, elemvec) 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. diff --git a/gdb/value.h b/gdb/value.h index 7708a44..8979dbe 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -186,8 +186,9 @@ extern int value_fetch_lazy PARAMS ((value_ptr val)); #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); \ @@ -195,6 +196,9 @@ extern int value_fetch_lazy PARAMS ((value_ptr val)); 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) \ @@ -504,6 +508,10 @@ extern int baseclass_offset PARAMS ((struct type *, int, value_ptr, int)); /* 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)); |