diff options
| -rw-r--r-- | gdb/ChangeLog | 57 | ||||
| -rw-r--r-- | gdb/c-lang.c | 6 | ||||
| -rw-r--r-- | gdb/c-typeprint.c | 4 | ||||
| -rw-r--r-- | gdb/ch-lang.c | 17 | ||||
| -rw-r--r-- | gdb/ch-lang.h | 5 | ||||
| -rw-r--r-- | gdb/eval.c | 111 | ||||
| -rw-r--r-- | gdb/expression.h | 2 | ||||
| -rw-r--r-- | gdb/f-exp.y | 31 | ||||
| -rw-r--r-- | gdb/f-lang.c | 63 | ||||
| -rw-r--r-- | gdb/f-typeprint.c | 10 | ||||
| -rw-r--r-- | gdb/f-valprint.c | 148 | ||||
| -rw-r--r-- | gdb/gdbtypes.c | 90 | ||||
| -rw-r--r-- | gdb/gdbtypes.h | 9 | ||||
| -rw-r--r-- | gdb/language.c | 6 | ||||
| -rw-r--r-- | gdb/language.h | 6 | ||||
| -rw-r--r-- | gdb/m2-lang.c | 20 | ||||
| -rw-r--r-- | gdb/mdebugread.c | 17 | ||||
| -rw-r--r-- | gdb/parse.c | 4 |
18 files changed, 181 insertions, 425 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index b3fc3c0..e11602b 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,5 +1,62 @@ Wed Feb 1 15:44:11 1995 Per Bothner <bothner@kalessin.cygnus.com> + * eval.c (evaluate_subexp): Clean up handling of + OP_UNDETERMINED_ARGLIST (no backtracking, more general). + + * f-valprint.c (f_val_print): Print TYPE_CODE_STRING using + LA_PRINT_STRING, and not val_print_string (which reads from inferior). + + * ch-lang.c (chill_is_varying_struct), ch-lang.h: Remve function + duplicate function made redundant by chill_varying_type. + + Re-write of f77 string and complex number support: + + * language.h (struct language_defn): New fields string_lower_bound + and string_char_type. + * c-lang.c (c_language_defn, cplus_language_defn, asm_language_defn), + language.c (unknown_language_defn, auto_language_defn, + local_language_defn), m2-lang.c (m2_language_defn), f-lang.c + (f_language_defn), ch-lang.c (chill_language_defn): Set new fields. + * gdbtypes.c (create_string_type): Use new string_char_type field. + * valops.c (value_string): Use new string_lower_bound field. + + * defs.h (TARGET_COMPLEX_BIT, TARGET_DOUBLE_COMPLEX_BIT): Removed. + * f-lang.c (f_create_fundamental_type, _initialize_f_language), + m2-lang.c (m2_create_fundamental_type), + gdbtypes.c (_initialize_gdbtypes): Set TYPE_TARGET_TYPE of complex + types. Set their TYPE_CODEs to TYPE_CODE_COMPLEX. + * mdebugread.c (mdebug_type_complex, mdebug_type_double_complex): + Removed. Use builtin_type_complex and builtin_type_double_complex. + + * gdbtypes.h (enum type_code): Removed TYPE_CODE_LITERAL_STRING + and TYPE_CODE_LITERAL_COMPLEX. + * c-typeprint.c, f-typeprint.c, f-valprint.c, eval.c: Removed uses of + TYPE_CODE_LITERAL_STRING and TYPE_CODE_LITERAL_COMPLEX. + * gdbtypes.c, gdbtypes.h (f77_create_literal_complex_type, + f77_create_literal_string_type): Removed. + * value.h (VALUE_LITERAL_DATA, VALUE_SUBSTRING_MEMADDR, + VALUE_SUBSTRING_MYADDR): Removed. + + * expression.h (enum exp_opcode): Rename OP_F77_LITERAL_COMPLEX to + OP_COMPLEX. + * parse.c: Update accordingly. + + * f-valprint.c (f77_print_cmplx): Removed. + (f_val_print case TYPE_CODE_COMPLEX): Re-write to use print_floating. + + * f-exp.y (STRING_LITERAL): Use OP_STRING instead of OP_ARRAY. + * eval.c (evaluate_subexp): For case OP_ARRAY, don't call + f77_value_literal_string. + * valops.c, value.h (f77_value_literal_string, f77_value_substring, + f77_assign_from_literal_string, f77_assign_from_literal_complex): + Removed. + (value_assign): No longer need to handle literal types. + * valops.c (f77_value_literal_complex), value.h: Re-written and + renamed to value_literal_complex. Last arg is now a (complex) type. + * valops.c (f77_cast_into_complex): Re-written and renamed to + cast_into_complex. + * eval.c (evaluate_subexp): Update accordingly. + * ch-valprint.c (chill_val_print): On TYPE_CODE_STRING, don't print address for non-'s'-formats. * ch-typeprint.c, ch-valprint.c: Use chill_varying_type instead diff --git a/gdb/c-lang.c b/gdb/c-lang.c index eccd230..5c6b0b5 100644 --- a/gdb/c-lang.c +++ b/gdb/c-lang.c @@ -411,6 +411,8 @@ const struct language_defn c_language_defn = { {"0x%lx", "0x", "x", ""}, /* Hex format info */ c_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ + 0, /* String lower bound */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; @@ -434,6 +436,8 @@ const struct language_defn cplus_language_defn = { {"0x%lx", "0x", "x", ""}, /* Hex format info */ c_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ + 0, /* String lower bound */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; @@ -457,6 +461,8 @@ const struct language_defn asm_language_defn = { {"0x%lx", "0x", "x", ""}, /* Hex format info */ c_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ + 0, /* String lower bound */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; diff --git a/gdb/c-typeprint.c b/gdb/c-typeprint.c index 01a9a73..306123d 100644 --- a/gdb/c-typeprint.c +++ b/gdb/c-typeprint.c @@ -315,8 +315,6 @@ c_type_print_varspec_prefix (type, stream, show, passed_a_ptr) case TYPE_CODE_STRING: case TYPE_CODE_BITSTRING: case TYPE_CODE_COMPLEX: - case TYPE_CODE_LITERAL_COMPLEX: - case TYPE_CODE_LITERAL_STRING: /* These types need no prefix. They are listed here so that gcc -Wall will reveal any types that haven't been handled. */ break; @@ -442,8 +440,6 @@ c_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args) case TYPE_CODE_STRING: case TYPE_CODE_BITSTRING: case TYPE_CODE_COMPLEX: - case TYPE_CODE_LITERAL_COMPLEX: - case TYPE_CODE_LITERAL_STRING: /* These types do not need a suffix. They are listed so that gcc -Wall will report types that may not have been considered. */ break; diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c index a3d2d14..7060ce1 100644 --- a/gdb/ch-lang.c +++ b/gdb/ch-lang.c @@ -182,21 +182,6 @@ chill_printstr (stream, string, length, force_ellipses) } } -/* Return 1 if TYPE is a varying string or array. */ - -int -chill_is_varying_struct (type) - struct type *type; -{ - if (TYPE_CODE (type) != TYPE_CODE_STRUCT) - return 0; - if (TYPE_NFIELDS (type) != 2) - return 0; - if (strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0) - return 0; - return 1; -} - static struct type * chill_create_fundamental_type (objfile, typeid) struct objfile *objfile; @@ -324,6 +309,8 @@ const struct language_defn chill_language_defn = { {"H'%lx", "H'", "x", ""}, /* Hex format info */ chill_op_print_tab, /* expression operators for printing */ 0, /* arrays are first-class (not c-style) */ + 0, /* String lower bound */ + &builtin_type_chill_char, /* Type of string elements */ LANG_MAGIC }; diff --git a/gdb/ch-lang.h b/gdb/ch-lang.h index 0fcb8d6..2913cd0 100644 --- a/gdb/ch-lang.h +++ b/gdb/ch-lang.h @@ -37,8 +37,3 @@ chill_val_print PARAMS ((struct type *, char *, CORE_ADDR, GDB_FILE *, int, int, extern int chill_value_print PARAMS ((struct value *, GDB_FILE *, int, enum val_prettyprint)); - -extern int -chill_is_varying_struct PARAMS ((struct type *type)); - - @@ -237,7 +237,6 @@ evaluate_subexp (expect_type, exp, pos, noside) struct type *type; int nargs; value_ptr *argvec; - int tmp_pos, tmp1_pos; struct symbol *tmp_symbol; int upper, lower, retcode; int code; @@ -430,11 +429,7 @@ evaluate_subexp (expect_type, exp, pos, noside) } 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: { @@ -629,6 +624,8 @@ evaluate_subexp (expect_type, exp, pos, noside) argvec[0] = arg1; } + do_call_it: + if (noside == EVAL_SKIP) goto nosideret; if (noside == EVAL_AVOID_SIDE_EFFECTS) @@ -652,8 +649,6 @@ evaluate_subexp (expect_type, exp, pos, noside) 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, @@ -673,89 +668,42 @@ evaluate_subexp (expect_type, exp, pos, noside) 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); @@ -763,6 +711,9 @@ evaluate_subexp (expect_type, 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) @@ -780,16 +731,15 @@ evaluate_subexp (expect_type, exp, pos, noside) 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); @@ -1014,7 +964,7 @@ evaluate_subexp (expect_type, exp, pos, noside) } return (arg1); - case MULTI_F77_SUBSCRIPT: + multi_f77_subscript: { int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of subscripts, max == 7 */ @@ -1024,13 +974,8 @@ evaluate_subexp (expect_type, exp, pos, noside) 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)); diff --git a/gdb/expression.h b/gdb/expression.h index d9c7bfe..6a166db 100644 --- a/gdb/expression.h +++ b/gdb/expression.h @@ -191,7 +191,7 @@ enum exp_opcode /* 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, + OP_COMPLEX, /* The following OP introduces a F77 substring operator. It should have a string type and two integer types that follow diff --git a/gdb/f-exp.y b/gdb/f-exp.y index df22468..ad31224 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -279,7 +279,7 @@ complexnum: exp ',' exp ; exp : '(' complexnum ')' - { write_exp_elt_opcode(OP_F77_LITERAL_COMPLEX); } + { write_exp_elt_opcode(OP_COMPLEX); } ; exp : '(' type ')' exp %prec UNARY @@ -436,32 +436,11 @@ exp : BOOLEAN_LITERAL ; exp : STRING_LITERAL - { /* In F77, we encounter string literals - basically in only one place: - when we are setting up manual parameter - lists to functions we call by hand or - when setting string vars to manual values. - These are character*N type variables. - They are treated specially behind the - scenes. Remember that the literal strings's - OPs are being emitted in reverse order, thus - we first have the elements and then - the array descriptor itself. */ - char *sp = $1.ptr; int count = $1.length; - - while (count-- > 0) - { - write_exp_elt_opcode (OP_LONG); - write_exp_elt_type (builtin_type_f_character); - write_exp_elt_longcst ((LONGEST)(*sp++)); - write_exp_elt_opcode (OP_LONG); - } - write_exp_elt_opcode (OP_ARRAY); - write_exp_elt_longcst ((LONGEST) 1); - write_exp_elt_longcst ((LONGEST) ($1.length)); - write_exp_elt_opcode (OP_ARRAY); + { + write_exp_elt_opcode (OP_STRING); + write_exp_string ($1); + write_exp_elt_opcode (OP_STRING); } - ; variable: name_not_typename diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 0232a54..7ccae4f 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -28,6 +28,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "language.h" #include "f-lang.h" +/* The built-in types of F77. FIXME: integer*4 is missing, plain + logical is missing (builtin_type_logical is logical*4). */ + +struct type *builtin_type_f_character; +struct type *builtin_type_f_logical; +struct type *builtin_type_f_logical_s1; +struct type *builtin_type_f_logical_s2; +struct type *builtin_type_f_integer; +struct type *builtin_type_f_integer_s2; +struct type *builtin_type_f_real; +struct type *builtin_type_f_real_s8; +struct type *builtin_type_f_real_s16; +struct type *builtin_type_f_complex_s8; +struct type *builtin_type_f_complex_s16; +struct type *builtin_type_f_complex_s32; +struct type *builtin_type_f_void; + /* Print the character C on STREAM as part of the contents of a literal string whose delimiter is QUOTER. Note that that format for printing characters and strings is language specific. @@ -318,19 +335,22 @@ f_create_fundamental_type (objfile, typeid) 0, "real*16", objfile); break; case FT_COMPLEX: - type = init_type (TYPE_CODE_FLT, - TARGET_COMPLEX_BIT / TARGET_CHAR_BIT, + type = init_type (TYPE_CODE_COMPLEX, + 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 0, "complex*8", objfile); + TYPE_TARGET_TYPE (type) = builtin_type_f_real; break; case FT_DBL_PREC_COMPLEX: - type = init_type (TYPE_CODE_FLT, - TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, + type = init_type (TYPE_CODE_COMPLEX, + 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "complex*16", objfile); + TYPE_TARGET_TYPE (type) = builtin_type_f_real_s8; break; case FT_EXT_PREC_COMPLEX: - type = init_type (TYPE_CODE_FLT, - TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, + type = init_type (TYPE_CODE_COMPLEX, + 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "complex*32", objfile); + TYPE_TARGET_TYPE (type) = builtin_type_f_real_s16; break; default: /* FIXME: For now, if we are asked to produce a type not in this @@ -373,23 +393,6 @@ static const struct op_print f_op_print_tab[] = { { NULL, 0, 0, 0 } }; -/* The built-in types of F77. FIXME: integer*4 is missing, plain - logical is missing (builtin_type_logical is logical*4). */ - -struct type *builtin_type_f_character; -struct type *builtin_type_f_logical; -struct type *builtin_type_f_logical_s1; -struct type *builtin_type_f_logical_s2; -struct type *builtin_type_f_integer; -struct type *builtin_type_f_integer_s2; -struct type *builtin_type_f_real; -struct type *builtin_type_f_real_s8; -struct type *builtin_type_f_real_s16; -struct type *builtin_type_f_complex_s8; -struct type *builtin_type_f_complex_s16; -struct type *builtin_type_f_complex_s32; -struct type *builtin_type_f_void; - struct type ** const (f_builtin_types[]) = { &builtin_type_f_character, @@ -432,6 +435,8 @@ const struct language_defn f_language_defn = { {"0x%x", "0x", "x", ""}, /* Hex format info */ f_op_print_tab, /* expression operators for printing */ 0, /* arrays are first-class (not c-style) */ + 1, /* String lower bound */ + &builtin_type_f_character, /* Type of string elements */ LANG_MAGIC }; @@ -489,24 +494,26 @@ _initialize_f_language () "real*16", (struct objfile *) NULL); builtin_type_f_complex_s8 = - init_type (TYPE_CODE_COMPLEX, TARGET_COMPLEX_BIT / TARGET_CHAR_BIT, + init_type (TYPE_CODE_COMPLEX, 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 0, "complex*8", (struct objfile *) NULL); + TYPE_TARGET_TYPE (builtin_type_f_complex_s8) = builtin_type_f_real; builtin_type_f_complex_s16 = - init_type (TYPE_CODE_COMPLEX, TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, + init_type (TYPE_CODE_COMPLEX, 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "complex*16", (struct objfile *) NULL); + TYPE_TARGET_TYPE (builtin_type_f_complex_s16) = builtin_type_f_real_s8; -#if 0 /* We have a new size == 4 double floats for the complex*32 data type */ builtin_type_f_complex_s32 = - init_type (TYPE_CODE_COMPLEX, TARGET_EXT_COMPLEX_BIT / TARGET_CHAR_BIT, + init_type (TYPE_CODE_COMPLEX, 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "complex*32", (struct objfile *) NULL); -#endif + TYPE_TARGET_TYPE (builtin_type_f_complex_s32) = builtin_type_f_real_s16; + builtin_type_string = init_type (TYPE_CODE_STRING, TARGET_CHAR_BIT / TARGET_CHAR_BIT, 0, diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 85f01e9..58558e4 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -144,8 +144,6 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr) case TYPE_CODE_MEMBER: case TYPE_CODE_REF: case TYPE_CODE_COMPLEX: - case TYPE_CODE_LITERAL_COMPLEX: - case TYPE_CODE_LITERAL_STRING: /* These types need no prefix. They are listed here so that gcc -Wall will reveal any types that haven't been handled. */ break; @@ -291,8 +289,6 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args) case TYPE_CODE_METHOD: case TYPE_CODE_MEMBER: case TYPE_CODE_COMPLEX: - case TYPE_CODE_LITERAL_COMPLEX: - case TYPE_CODE_LITERAL_STRING: /* These types do not need a suffix. They are listed so that gcc -Wall will report types that may not have been considered. */ break; @@ -413,7 +409,6 @@ f_type_print_base (type, stream, show, level) break; case TYPE_CODE_COMPLEX: - case TYPE_CODE_LITERAL_COMPLEX: fprintf_filtered (stream, "complex*"); fprintf_filtered (stream, "%d", TYPE_LENGTH (type)); break; @@ -422,11 +417,6 @@ f_type_print_base (type, stream, show, level) print_equivalent_f77_float_type (type, stream); break; - case TYPE_CODE_LITERAL_STRING: - fprintf_filtered (stream, "character*%d", - TYPE_ARRAY_UPPER_BOUND_VALUE (type)); - break; - case TYPE_CODE_STRING: /* Strings may have dynamic upperbounds (lengths) like arrays. */ diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 73d0f15..f094971 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -216,60 +216,6 @@ f77_get_dynamic_length_of_aggregate (type) (upper_bound - lower_bound + 1) * TYPE_LENGTH (TYPE_TARGET_TYPE (type)); } -/* Print a FORTRAN COMPLEX value of type TYPE, pointed to in GDB by VALADDR, - on STREAM. which_complex indicates precision, which may be regular, - *16, or *32 */ - -void -f77_print_cmplx (valaddr, type, stream, which_complex) - char *valaddr; - struct type *type; - FILE *stream; - int which_complex; -{ - float *f1,*f2; - double *d1, *d2; - - switch (which_complex) - { - case TARGET_COMPLEX_BIT: - f1 = (float *) valaddr; - f2 = (float *) (valaddr + sizeof(float)); - fprintf_filtered (stream, "(%.7e,%.7e)", *f1, *f2); - break; - - case TARGET_DOUBLE_COMPLEX_BIT: - d1 = (double *) valaddr; - d2 = (double *) (valaddr + sizeof(double)); - fprintf_filtered (stream, "(%.16e,%.16e)", *d1, *d2); - break; -#if 0 - case TARGET_EXT_COMPLEX_BIT: - fprintf_filtered (stream, "<complex*32 format unavailable, " - "printing raw data>\n"); - - fprintf_filtered (stream, "( [ "); - - for (i = 0;i<4;i++) - fprintf_filtered (stream, "0x%x ", - * ( (unsigned int *) valaddr+i)); - - fprintf_filtered (stream, "],\n [ "); - - for (i=4;i<8;i++) - fprintf_filtered (stream, "0x%x ", - * ((unsigned int *) valaddr+i)); - - fprintf_filtered (stream, "] )"); - - break; -#endif - default: - fprintf_filtered (stream, "<cannot handle complex of this type>"); - break; - } -} - /* Function that sets up the array offset,size table for the array type "type". */ @@ -446,45 +392,9 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse, switch (TYPE_CODE (type)) { - case TYPE_CODE_LITERAL_STRING: - /* It is trivial to print out F77 strings allocated in the - superior process. The address field is actually a - pointer to the bytes of the literal. For an internalvar, - valaddr points to a ptr. which points to - VALUE_LITERAL_DATA(value->internalvar->value) - and for straight literals (i.e. of the form 'hello world'), - valaddr points a ptr to VALUE_LITERAL_DATA(value). */ - - /* First dereference valaddr. This relies on valaddr pointing to the - aligner union of a struct value (so we are now fetching the - literal_data pointer from that union). FIXME: Is this always - true. */ - - straddr = * (char **) valaddr; - - if (straddr) - { - len = TYPE_LENGTH (type); - localstr = alloca (len + 1); - strncpy (localstr, straddr, len); - localstr[len] = '\0'; - fprintf_filtered (stream, "'%s'", localstr); - } - else - fprintf_filtered (stream, "Unable to print literal F77 string"); - break; - - /* Strings are a little bit funny. They can be viewed as - monolithic arrays that are dealt with as atomic data - items. As such they are the only atomic data items whose - contents are not located in the superior process. Instead - instead of having the actual data, they contain pointers - to addresses in the inferior where data is located. Thus - instead of using valaddr, we use address. */ - case TYPE_CODE_STRING: f77_get_dynamic_length_of_aggregate (type); - val_print_string (address, TYPE_LENGTH (type), stream); + LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 0); break; case TYPE_CODE_ARRAY: @@ -634,60 +544,20 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse, } break; - case TYPE_CODE_LITERAL_COMPLEX: - /* We know that the literal complex is stored in the superior - process not the inferior and that it is 16 bytes long. - Just like the case above with a literal array, the - bytes for the the literal complex number are stored - at the address pointed to by valaddr */ - - if (TYPE_LENGTH (type) == 32) - error ("Cannot currently print out complex*32 literals"); - - /* First dereference valaddr. */ - - addr = * (CORE_ADDR *) valaddr; - - if (addr) - { - fprintf_filtered (stream, "("); - - if (TYPE_LENGTH(type) == 16) - { - fprintf_filtered (stream, "%.16f", * (double *) addr); - fprintf_filtered (stream, ", %.16f", * (double *) - (addr + sizeof(double))); - } - else - { - fprintf_filtered (stream, "%.8f", * (float *) addr); - fprintf_filtered (stream, ", %.8f", * (float *) - (addr + sizeof(float))); - } - fprintf_filtered (stream, ") "); - } - else - fprintf_filtered (stream, "Unable to print literal F77 array"); - break; - case TYPE_CODE_COMPLEX: switch (TYPE_LENGTH (type)) { - case 8: - f77_print_cmplx (valaddr, type, stream, TARGET_COMPLEX_BIT); - break; - - case 16: - f77_print_cmplx(valaddr, type, stream, TARGET_DOUBLE_COMPLEX_BIT); - break; -#if 0 - case 32: - f77_print_cmplx(valaddr, type, stream, TARGET_EXT_COMPLEX_BIT); - break; -#endif + case 8: type = builtin_type_f_real; break; + case 16: type = builtin_type_f_real_s8; break; + case 32: type = builtin_type_f_real_s16; break; default: error ("Cannot print out complex*%d variables", TYPE_LENGTH(type)); } + fputs_filtered ("(", stream); + print_floating (valaddr, type, stream); + fputs_filtered (",", stream); + print_floating (valaddr, type, stream); + fputs_filtered (")", stream); break; case TYPE_CODE_UNDEF: diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index cc76898..2ccc845 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -451,7 +451,9 @@ create_string_type (result_type, range_type) struct type *result_type; struct type *range_type; { - result_type = create_array_type (result_type, builtin_type_char, range_type); + result_type = create_array_type (result_type, + *current_language->string_char_type, + range_type); TYPE_CODE (result_type) = TYPE_CODE_STRING; return (result_type); } @@ -486,86 +488,6 @@ create_set_type (result_type, domain_type) return (result_type); } -/* Create an F77 literal complex type composed of the two types we are - given as arguments. */ - -struct type * -f77_create_literal_complex_type (type_arg1, type_arg2) - struct type *type_arg1; - struct type *type_arg2; -{ - struct type *result; - - /* First make sure that the 2 components of the complex - number both have the same type */ - - if (TYPE_CODE (type_arg1) != TYPE_CODE (type_arg2)) - error ("Both components of a F77 complex number must have the same type!"); - - result = alloc_type (TYPE_OBJFILE (type_arg1)); - - TYPE_CODE (result) = TYPE_CODE_LITERAL_COMPLEX; - TYPE_LENGTH (result) = TYPE_LENGTH(type_arg1) * 2; - - return result; -} - -/* Create a F77 LITERAL string type supplied by the user from the keyboard. - - Elements will be of type ELEMENT_TYPE, the indices will be of type - RANGE_TYPE. - - FIXME: Maybe we should check the TYPE_CODE of RESULT_TYPE to make - sure it is TYPE_CODE_UNDEF before we bash it into an array type? - - This is a total clone of create_array_type() except that there are - a few simplyfing assumptions (e.g all bound types are simple). */ - -struct type * -f77_create_literal_string_type (result_type, range_type) - struct type *result_type; - struct type *range_type; -{ - int low_bound; - int high_bound; - - if (TYPE_CODE (range_type) != TYPE_CODE_RANGE) - { - /* FIXME: We only handle range types at the moment. Complain and - create a dummy range type to use. */ - warning ("internal error: array index type must be a range type"); - range_type = lookup_fundamental_type (TYPE_OBJFILE (range_type), - FT_INTEGER); - range_type = create_range_type ((struct type *) NULL, range_type, 0, 0); - } - if (result_type == NULL) - result_type = alloc_type (TYPE_OBJFILE (range_type)); - TYPE_CODE (result_type) = TYPE_CODE_LITERAL_STRING; - TYPE_TARGET_TYPE (result_type) = builtin_type_f_character; - low_bound = TYPE_FIELD_BITPOS (range_type, 0); - high_bound = TYPE_FIELD_BITPOS (range_type, 1); - - /* Safely can assume that all bound types are simple */ - - TYPE_LENGTH (result_type) = - TYPE_LENGTH (builtin_type_f_character) * (high_bound - low_bound + 1); - - TYPE_NFIELDS (result_type) = 1; - TYPE_FIELDS (result_type) = - (struct field *) TYPE_ALLOC (result_type, sizeof (struct field)); - memset (TYPE_FIELDS (result_type), 0, sizeof (struct field)); - TYPE_FIELD_TYPE (result_type, 0) = range_type; - TYPE_VPTR_FIELDNO (result_type) = -1; - - /* Remember that all literal strings in F77 are of the - character*N type. */ - - TYPE_ARRAY_LOWER_BOUND_TYPE (result_type) = BOUND_SIMPLE; - TYPE_ARRAY_UPPER_BOUND_TYPE (result_type) = BOUND_SIMPLE; - - return result_type; -} - /* Smash TYPE to be a type of members of DOMAIN with type TO_TYPE. A MEMBER is a wierd thing -- it amounts to a typed offset into a struct, e.g. "an int at offset 8". A MEMBER TYPE doesn't @@ -1663,13 +1585,15 @@ _initialize_gdbtypes () 0, "long double", (struct objfile *) NULL); builtin_type_complex = - init_type (TYPE_CODE_FLT, TARGET_COMPLEX_BIT / TARGET_CHAR_BIT, + init_type (TYPE_CODE_COMPLEX, 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 0, "complex", (struct objfile *) NULL); + TYPE_TARGET_TYPE (builtin_type_complex) = builtin_type_float; builtin_type_double_complex = - init_type (TYPE_CODE_FLT, TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, + init_type (TYPE_CODE_COMPLEX, 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "double complex", (struct objfile *) NULL); + TYPE_TARGET_TYPE (builtin_type_double_complex) = builtin_type_double; builtin_type_string = init_type (TYPE_CODE_STRING, TARGET_CHAR_BIT / TARGET_CHAR_BIT, 0, diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index 3e26098..b530f8c 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -121,8 +121,6 @@ enum type_code /* Fortran */ TYPE_CODE_COMPLEX, /* Complex float */ - TYPE_CODE_LITERAL_COMPLEX, /* */ - TYPE_CODE_LITERAL_STRING /* */ }; /* For now allow source to use TYPE_CODE_CLASS for C++ classes, as an @@ -214,6 +212,7 @@ struct type For an array type, describes the type of the elements. For a function or method type, describes the type of the return value. For a range type, describes the type of the full range. + For a complex type, describes the type of each coordinate. Unused otherwise. */ struct type *target_type; @@ -724,14 +723,8 @@ create_array_type PARAMS ((struct type *, struct type *, struct type *)); extern struct type * create_string_type PARAMS ((struct type *, struct type *)); -extern struct type *f77_create_literal_string_type PARAMS ((struct type *, - struct type *)); - 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 * diff --git a/gdb/language.c b/gdb/language.c index d8cbd56..eb917bc 100644 --- a/gdb/language.c +++ b/gdb/language.c @@ -1201,6 +1201,8 @@ const struct language_defn unknown_language_defn = { {"0x%lx", "0x", "x", ""}, /* Hex format info */ unk_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ + 0, /* String lower bound */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; @@ -1225,6 +1227,8 @@ const struct language_defn auto_language_defn = { {"0x%lx", "0x", "x", ""}, /* Hex format info */ unk_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ + 0, /* String lower bound */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; @@ -1248,6 +1252,8 @@ const struct language_defn local_language_defn = { {"0x%lx", "0x", "x", ""}, /* Hex format info */ unk_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ + 0, /* String lower bound */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; diff --git a/gdb/language.h b/gdb/language.h index 6122bbf..0e263ba 100644 --- a/gdb/language.h +++ b/gdb/language.h @@ -177,6 +177,12 @@ struct language_defn char c_style_arrays; + /* Index to use for extracting the first element of a string. */ + char string_lower_bound; + + /* Type of elements of strings. */ + struct type **string_char_type; + /* Add fields above this point, so the magic number is always last. */ /* Magic number for compat checking */ diff --git a/gdb/m2-lang.c b/gdb/m2-lang.c index c7b7530..a812821 100644 --- a/gdb/m2-lang.c +++ b/gdb/m2-lang.c @@ -330,19 +330,25 @@ m2_create_fundamental_type (objfile, typeid) 0, "long double", objfile); break; case FT_COMPLEX: - type = init_type (TYPE_CODE_FLT, - TARGET_COMPLEX_BIT / TARGET_CHAR_BIT, + type = init_type (TYPE_CODE_COMPLEX, + 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 0, "complex", objfile); + TYPE_TARGET_TYPE (type) + = m2_create_fundamental_type (objfile, FT_FLOAT); break; case FT_DBL_PREC_COMPLEX: - type = init_type (TYPE_CODE_FLT, - TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, + type = init_type (TYPE_CODE_COMPLEX, + 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "double complex", objfile); + TYPE_TARGET_TYPE (type) + = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT); break; case FT_EXT_PREC_COMPLEX: - type = init_type (TYPE_CODE_FLT, - TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, + type = init_type (TYPE_CODE_COMPLEX, + 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 0, "long double complex", objfile); + TYPE_TARGET_TYPE (type) + = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT); break; } return (type); @@ -413,6 +419,8 @@ const struct language_defn m2_language_defn = { {"0%lXH", "0", "X", "H"}, /* Hex format info */ m2_op_print_tab, /* expression operators for printing */ 0, /* arrays are first-class (not c-style) */ + 0, /* String lower bound */ + &builtin_type_m2_char, /* Type of string elements */ LANG_MAGIC }; diff --git a/gdb/mdebugread.c b/gdb/mdebugread.c index 7b30ec3..8d6c27d 100644 --- a/gdb/mdebugread.c +++ b/gdb/mdebugread.c @@ -274,8 +274,6 @@ static char stabs_symbol[] = STABS_SYMBOL; be using our own types thoughout this file, instead of sometimes using builtin_type_*. */ -static struct type *mdebug_type_complex; -static struct type *mdebug_type_double_complex; static struct type *mdebug_type_fixed_dec; static struct type *mdebug_type_float_dec; static struct type *mdebug_type_string; @@ -1358,8 +1356,8 @@ parse_type (fd, ax, aux_index, bs, bigend, sym_name) 0, /* btTypedef */ 0, /* btRange */ 0, /* btSet */ - &mdebug_type_complex, /* btComplex */ - &mdebug_type_double_complex, /* btDComplex */ + &builtin_type_complex, /* btComplex */ + &builtin_type_double_complex,/* btDComplex */ 0, /* btIndirect */ &mdebug_type_fixed_dec, /* btFixedDec */ &mdebug_type_float_dec, /* btFloatDec */ @@ -4065,17 +4063,6 @@ _initialize_mdebugread () 0, "string", (struct objfile *) NULL); - mdebug_type_complex = - init_type (TYPE_CODE_ERROR, - TARGET_COMPLEX_BIT / TARGET_CHAR_BIT, - 0, "complex", - (struct objfile *) NULL); - mdebug_type_double_complex = - init_type (TYPE_CODE_ERROR, - TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT, - 0, "double complex", - (struct objfile *) NULL); - /* We use TYPE_CODE_INT to print these as integers. Does this do any good? Would we be better off with TYPE_CODE_ERROR? Should TYPE_CODE_ERROR print things in hex if it knows the size? */ diff --git a/gdb/parse.c b/gdb/parse.c index 0defac0f..e2723b7 100644 --- a/gdb/parse.c +++ b/gdb/parse.c @@ -470,7 +470,7 @@ length_of_subexp (expr, endpos) oplen = 3; break; - case OP_F77_LITERAL_COMPLEX: + case OP_COMPLEX: oplen = 1; args = 2; break; @@ -615,7 +615,7 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg) oplen = 3; break; - case OP_F77_LITERAL_COMPLEX: + case OP_COMPLEX: oplen = 1; args = 2; break; |