From: Stan Shebs Date: Wed, 7 Sep 1994 00:23:16 +0000 (+0000) Subject: * c-typeprint.c (c_type_print_varspec_prefix, X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=22d7f91e32bda141f2d866c3e7dd967141dcf696;p=binutils-gdb.git * c-typeprint.c (c_type_print_varspec_prefix, c_type_print_varspec_suffix): Add cases for Fortran type codes. * eval.c (evaluate_subexp): For OP_ARRAY expressions in Fortran, call f77_value_literal_string instead. * f_exp.y: Include , move include of parser-defs.h. (parse_number): Translate 'd' floats to 'e' so atof() works. (yylex): Remove unused variables. * f-lang.c: Include . (get_bf_for_fcn): Remove unused variable. * f-typeprint.c (f_type_print_varspec_prefix, f_type_print_varspec_suffix): Remove unused variables, add cases to switch statements. (f_type_print_base): Remove unused variables. * f-valprint.c (gdbcore.h, command.h): Include. (f77_get_dynamic_lowerbound, f77_get_dynamic_upperbound): Call read_memory_integer with correct number of arguments. (f77_get_dynamic_upperbound): Call f77_get_dynamic_lowerbound with correct argument type. (f77_print_array): Removed unused array array_size_array. (f_val_print): Don't use a CORE_ADDR as a char *. * valops.c (value_cast): Handle COMPLEX and BOOL types. (value_assign): Handle Fortran literal string and complex values. (f77_cast_into_complex, f77_assign_from_literal_string, f77_assign_from_literal_complex): New functions. --- diff --git a/gdb/ChangeLog b/gdb/ChangeLog index a4ec0612cda..5520f01ecad 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,30 @@ +Tue Sep 6 16:24:07 1994 Stan Shebs (shebs@andros.cygnus.com) + + * c-typeprint.c (c_type_print_varspec_prefix, + c_type_print_varspec_suffix): Add cases for Fortran type codes. + * eval.c (evaluate_subexp): For OP_ARRAY expressions in Fortran, + call f77_value_literal_string instead. + * f_exp.y: Include , move include of parser-defs.h. + (parse_number): Translate 'd' floats to 'e' so atof() works. + (yylex): Remove unused variables. + * f-lang.c: Include . + (get_bf_for_fcn): Remove unused variable. + * f-typeprint.c (f_type_print_varspec_prefix, + f_type_print_varspec_suffix): Remove unused + variables, add cases to switch statements. + (f_type_print_base): Remove unused variables. + * f-valprint.c (gdbcore.h, command.h): Include. + (f77_get_dynamic_lowerbound, f77_get_dynamic_upperbound): + Call read_memory_integer with correct number of arguments. + (f77_get_dynamic_upperbound): Call f77_get_dynamic_lowerbound + with correct argument type. + (f77_print_array): Removed unused array array_size_array. + (f_val_print): Don't use a CORE_ADDR as a char *. + * valops.c (value_cast): Handle COMPLEX and BOOL types. + (value_assign): Handle Fortran literal string and complex values. + (f77_cast_into_complex, f77_assign_from_literal_string, + f77_assign_from_literal_complex): New functions. + Mon Sep 5 14:46:41 1994 Per Bothner (bothner@kalessin.cygnus.com) * ch-typeprint.c (chill_type_print_base): Make TYPE_CODE_RANGE diff --git a/gdb/c-typeprint.c b/gdb/c-typeprint.c index 60268b2a012..6d5a85a06d4 100644 --- a/gdb/c-typeprint.c +++ b/gdb/c-typeprint.c @@ -312,6 +312,9 @@ c_type_print_varspec_prefix (type, stream, show, passed_a_ptr) case TYPE_CODE_RANGE: 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; @@ -436,6 +439,9 @@ c_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args) case TYPE_CODE_RANGE: 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/f-exp.y b/gdb/f-exp.y index 27eda230989..6270fc74a6a 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -43,9 +43,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ %{ #include "defs.h" +#include #include "expression.h" -#include "parser-defs.h" #include "value.h" +#include "parser-defs.h" #include "language.h" #include "f-lang.h" #include "bfd.h" /* Required by objfiles.h. */ @@ -214,7 +215,6 @@ type_exp: type write_exp_elt_opcode(OP_TYPE); } ; - exp : '(' exp ')' { } ; @@ -390,8 +390,7 @@ exp : NAME_OR_INT write_exp_elt_opcode (OP_LONG); write_exp_elt_type (val.typed_val.type); write_exp_elt_longcst ((LONGEST)val.typed_val.val); - write_exp_elt_opcode (OP_LONG); - } + write_exp_elt_opcode (OP_LONG); } ; exp : FLOAT @@ -668,7 +667,15 @@ parse_number (p, len, parsed_float, putithere) if (parsed_float) { /* It's a float since it contains a point or an exponent. */ - putithere->dval = atof (p); + /* [dD] is not understood as an exponent by atof, change it to 'e'. */ + char *tmp, *tmp2; + + tmp = strsave (p); + for (tmp2 = tmp; *tmp2; ++tmp2) + if (*tmp2 == 'd' || *tmp2 == 'D') + *tmp2 = 'e'; + putithere->dval = atof (tmp); + free (tmp); return FLOAT; } @@ -931,10 +938,6 @@ yylex () int namelen; unsigned int i,token; char *tokstart; - char *tokptr; - int tempbufindex; - static char *tempbuf; - static int tempbufsize; retry: @@ -945,14 +948,14 @@ yylex () if (*lexptr == '.') { - for (i=0;boolean_values[i].name != NULL;i++) + for (i = 0; boolean_values[i].name != NULL; i++) { - if STREQN(tokstart,boolean_values[i].name, - strlen(boolean_values[i].name)) + if STREQN (tokstart, boolean_values[i].name, + strlen (boolean_values[i].name)) { - lexptr += strlen(boolean_values[i].name); + lexptr += strlen (boolean_values[i].name); yylval.lval = boolean_values[i].value; - return (BOOLEAN_LITERAL); + return BOOLEAN_LITERAL; } } } @@ -960,10 +963,9 @@ yylex () /* See if it is a special .foo. operator */ for (i = 0; dot_ops[i].operator != NULL; i++) - if (STREQN(tokstart, dot_ops[i].operator, - strlen(dot_ops[i].operator))) + if (STREQN (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator))) { - lexptr += strlen(dot_ops[i].operator); + lexptr += strlen (dot_ops[i].operator); yylval.opcode = dot_ops[i].opcode; return dot_ops[i].token; } @@ -1040,12 +1042,12 @@ yylex () { if (!hex && !got_e && (*p == 'e' || *p == 'E')) got_dot = got_e = 1; - else if (!hex && !got_e && (*p == 'd' || *p == 'D')) + else if (!hex && !got_d && (*p == 'd' || *p == 'D')) got_dot = got_d = 1; else if (!hex && !got_dot && *p == '.') got_dot = 1; - else if ((got_e && (p[-1] == 'e' || p[-1] == 'E') - || got_d && (p[-1] == 'd' || p[-1] == 'D')) + else if ((got_e && (p[-1] == 'e' || p[-1] == 'E')) + || (got_d && (p[-1] == 'd' || p[-1] == 'D')) && (*p == '-' || *p == '+')) /* This is the sign of the exponent, not the end of the number. */ diff --git a/gdb/f-lang.c b/gdb/f-lang.c index f9d55b7366b..77dce4f5179 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -20,6 +20,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "defs.h" +#include #include "symtab.h" #include "gdbtypes.h" #include "expression.h" @@ -882,7 +883,6 @@ get_bf_for_fcn (the_function) { SAVED_BF_PTR tmp; int nprobes = 0; - long retval = 0; /* First use a simple queuing algorithm (i.e. look and see if the item at the head of the queue is the one you want) */ diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 3540f48cb89..85f01e93dea 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -1,5 +1,5 @@ /* Support for printing Fortran types for GDB, the GNU debugger. - Copyright 1986, 1988, 1989, 1991 Free Software Foundation, Inc. + Copyright 1986, 1988, 1989, 1991, 1993, 1994 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C version by Farooq Butt (fmbutt@engage.sps.mot.com). @@ -102,7 +102,6 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr) int show; int passed_a_ptr; { - char *name; if (type == 0) return; @@ -140,6 +139,13 @@ f_type_print_varspec_prefix (type, stream, show, passed_a_ptr) case TYPE_CODE_SET: case TYPE_CODE_RANGE: case TYPE_CODE_STRING: + case TYPE_CODE_BITSTRING: + case TYPE_CODE_METHOD: + 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; @@ -192,8 +198,7 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args) int passed_a_ptr; int demangled_args; { - CORE_ADDR current_frame_addr = 0; - int upper_bound,lower_bound; + int upper_bound, lower_bound; int lower_bound_was_default = 0; static int arrayprint_recurse_level = 0; int retcode; @@ -281,15 +286,19 @@ f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args) case TYPE_CODE_BOOL: case TYPE_CODE_SET: case TYPE_CODE_RANGE: - case TYPE_CODE_LITERAL_STRING: case TYPE_CODE_STRING: + case TYPE_CODE_BITSTRING: + 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; } } - void print_equivalent_f77_float_type (type, stream) struct type *type; @@ -331,14 +340,9 @@ f_type_print_base (type, stream, show, level) int show; int level; { - char *name; - register int i; - register int len; - register int lastval; - char *mangled_name; - char *demangled_name; - enum {s_none, s_public, s_private, s_protected} section_type; - int retcode,upper_bound; + int retcode; + int upper_bound; + QUIT; wrap_here (" "); @@ -353,9 +357,6 @@ f_type_print_base (type, stream, show, level) if ((show <= 0) && (TYPE_NAME (type) != NULL)) { - /* Damn builtin types on RS6000! They call a float "float" - so we gotta translate to appropriate F77'isms */ - if (TYPE_CODE (type) == TYPE_CODE_FLT) print_equivalent_f77_float_type (type, stream); else @@ -405,20 +406,20 @@ f_type_print_base (type, stream, show, level) through as TYPE_CODE_INT since dbxstclass.h is so C-oriented, we must change these to "character" from "char". */ - if (STREQ(TYPE_NAME(type),"char")) - fprintf_filtered (stream,"character"); + if (STREQ (TYPE_NAME (type), "char")) + fprintf_filtered (stream, "character"); else goto default_case; break; case TYPE_CODE_COMPLEX: case TYPE_CODE_LITERAL_COMPLEX: - fprintf_filtered (stream,"complex*"); - fprintf_filtered (stream,"%d",TYPE_LENGTH(type)); + fprintf_filtered (stream, "complex*"); + fprintf_filtered (stream, "%d", TYPE_LENGTH (type)); break; case TYPE_CODE_FLT: - print_equivalent_f77_float_type(type,stream); + print_equivalent_f77_float_type (type, stream); break; case TYPE_CODE_LITERAL_STRING: @@ -427,18 +428,18 @@ f_type_print_base (type, stream, show, level) break; case TYPE_CODE_STRING: - /* Strings may have dynamic upperbounds (lengths) like arrays */ + /* Strings may have dynamic upperbounds (lengths) like arrays. */ if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) - fprintf_filtered("character*(*)"); + fprintf_filtered ("character*(*)"); else { - retcode = f77_get_dynamic_upperbound(type,&upper_bound); + retcode = f77_get_dynamic_upperbound (type, &upper_bound); if (retcode == BOUND_FETCH_ERROR) - fprintf_filtered(stream,"character*???"); + fprintf_filtered (stream, "character*???"); else - fprintf_filtered(stream,"character*%d",upper_bound); + fprintf_filtered (stream, "character*%d", upper_bound); } break; diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 0e0cdbc9e07..2f2bd144387 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -20,6 +20,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "defs.h" +#include #include "symtab.h" #include "gdbtypes.h" #include "expression.h" @@ -29,11 +30,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "language.h" #include "f-lang.h" #include "frame.h" +#include "gdbcore.h" +#include "command.h" extern struct obstack dont_print_obstack; extern unsigned int print_max; /* No of array elements to print */ +extern int calc_f77_array_dims PARAMS ((struct type *)); + int f77_array_offset_tbl[MAX_FORTRAN_DIMS+1][2]; /* Array which holds offsets to be applied to get a row's elements @@ -64,7 +69,8 @@ f77_get_dynamic_lowerbound (type, lower_bound) { *lower_bound = read_memory_integer (current_frame_addr + - TYPE_ARRAY_LOWER_BOUND_VALUE (type),4); + TYPE_ARRAY_LOWER_BOUND_VALUE (type), + 4); } else { @@ -78,7 +84,7 @@ f77_get_dynamic_lowerbound (type, lower_bound) break; case BOUND_CANNOT_BE_DETERMINED: - error("Lower bound may not be '*' in F77"); + error ("Lower bound may not be '*' in F77"); break; case BOUND_BY_REF_ON_STACK: @@ -89,7 +95,7 @@ f77_get_dynamic_lowerbound (type, lower_bound) read_memory_integer (current_frame_addr + TYPE_ARRAY_LOWER_BOUND_VALUE (type), 4); - *lower_bound = read_memory_integer(ptr_to_lower_bound); + *lower_bound = read_memory_integer (ptr_to_lower_bound, 4); } else { @@ -123,7 +129,8 @@ f77_get_dynamic_upperbound (type, upper_bound) { *upper_bound = read_memory_integer (current_frame_addr + - TYPE_ARRAY_UPPER_BOUND_VALUE (type),4); + TYPE_ARRAY_UPPER_BOUND_VALUE (type), + 4); } else { @@ -142,7 +149,7 @@ f77_get_dynamic_upperbound (type, upper_bound) 1 element.If the user wants to see more elements, let him manually ask for 'em and we'll subscript the array and show him */ - f77_get_dynamic_lowerbound (type, &upper_bound); + f77_get_dynamic_lowerbound (type, upper_bound); break; case BOUND_BY_REF_ON_STACK: @@ -153,7 +160,7 @@ f77_get_dynamic_upperbound (type, upper_bound) read_memory_integer (current_frame_addr + TYPE_ARRAY_UPPER_BOUND_VALUE (type), 4); - *upper_bound = read_memory_integer(ptr_to_upper_bound); + *upper_bound = read_memory_integer(ptr_to_upper_bound, 4); } else { @@ -179,13 +186,11 @@ f77_get_dynamic_length_of_aggregate (type) { int upper_bound = -1; int lower_bound = 1; - unsigned int current_total = 1; int retcode; - /* Recursively go all the way down into a possibly - multi-dimensional F77 array - and get the bounds. For simple arrays, this is pretty easy - but when the bounds are dynamic, we must be very careful + /* Recursively go all the way down into a possibly multi-dimensional + F77 array and get the bounds. For simple arrays, this is pretty + easy but when the bounds are dynamic, we must be very careful to add up all the lengths correctly. Not doing this right will lead to horrendous-looking arrays in parameter lists. @@ -224,7 +229,6 @@ f77_print_cmplx (valaddr, type, stream, which_complex) { float *f1,*f2; double *d1, *d2; - int i; switch (which_complex) { @@ -267,7 +271,7 @@ f77_print_cmplx (valaddr, type, stream, which_complex) } /* Function that sets up the array offset,size table for the array - type "type". */ + type "type". */ void f77_create_arrayprint_offset_tbl (type, stream) @@ -388,7 +392,6 @@ f77_print_array (type, valaddr, address, stream, format, deref_ref, recurse, int recurse; enum val_prettyprint pretty; { - int array_size_array[MAX_FORTRAN_DIMS+1]; int ndimensions; ndimensions = calc_f77_array_dims (type); @@ -436,11 +439,9 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse, register unsigned int i = 0; /* Number of characters printed */ unsigned len; struct type *elttype; - unsigned eltlen; LONGEST val; - struct internalvar *ivar; - char *localstr; - unsigned char c; + char *localstr; + char *straddr; CORE_ADDR addr; switch (TYPE_CODE (type)) @@ -454,15 +455,15 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse, and for straight literals (i.e. of the form 'hello world'), valaddr points a ptr to VALUE_LITERAL_DATA(value). */ - /* First deref. valaddr */ + /* First dereference valaddr. */ - addr = * (CORE_ADDR *) valaddr; + straddr = * (CORE_ADDR *) valaddr; - if (addr) + if (straddr) { len = TYPE_LENGTH (type); localstr = alloca (len + 1); - strncpy (localstr, addr, len); + strncpy (localstr, straddr, len); localstr[len] = '\0'; fprintf_filtered (stream, "'%s'", localstr); } @@ -637,10 +638,10 @@ f_val_print (type, valaddr, address, stream, format, deref_ref, recurse, 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"); + if (TYPE_LENGTH (type) == 32) + error ("Cannot currently print out complex*32 literals"); - /* First deref. valaddr */ + /* First dereference valaddr. */ addr = * (CORE_ADDR *) valaddr; @@ -733,7 +734,6 @@ info_common_command (comname, from_tty) struct frame_info *fi; register char *funname = 0; struct symbol *func; - char *cmd; /* We have been told to display the contents of F77 COMMON block supposedly visible in this function. Let us @@ -825,7 +825,6 @@ there_is_a_visible_common_named (comname) char *comname; { SAVED_F77_COMMON_PTR the_common; - COMMON_ENTRY_PTR entry; struct frame_info *fi; register char *funname = 0; struct symbol *func;