From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 23144 invoked by alias); 16 Nov 2005 07:17:31 -0000 Received: (qmail 23103 invoked by uid 22791); 16 Nov 2005 07:17:27 -0000 Received: from ausmtp01.au.ibm.com (HELO ausmtp01.au.ibm.com) (202.81.18.186) by sourceware.org (qpsmtpd/0.30-dev) with ESMTP; Wed, 16 Nov 2005 07:17:27 +0000 Received: from sd0208e0.au.ibm.com (d23rh904.au.ibm.com [202.81.18.202]) by ausmtp01.au.ibm.com (8.12.10/8.12.10) with ESMTP id jAG7KQa6053532 for ; Wed, 16 Nov 2005 18:20:27 +1100 Received: from d23av01.au.ibm.com (d23av01.au.ibm.com [9.190.250.242]) by sd0208e0.au.ibm.com (8.12.10/NCO/VERS6.7) with ESMTP id jAG7KBln138754 for ; Wed, 16 Nov 2005 18:20:12 +1100 Received: from d23av01.au.ibm.com (loopback [127.0.0.1]) by d23av01.au.ibm.com (8.12.11/8.13.3) with ESMTP id jAG7H8YR032126 for ; Wed, 16 Nov 2005 18:17:08 +1100 Received: from [9.181.133.252] ([9.181.133.252]) by d23av01.au.ibm.com (8.12.11/8.12.11) with ESMTP id jAG7H61A031996; Wed, 16 Nov 2005 18:17:07 +1100 Date: Wed, 16 Nov 2005 10:35:00 -0000 From: Wu Zhou To: gdb-patches@sources.redhat.com cc: Thomas.Koenig@online.de Subject: [RFC]: Patch to support Fortran derived type - Revised Message-ID: MIME-Version: 1.0 Content-Type: TEXT/PLAIN; charset=US-ASCII Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org X-SW-Source: 2005-11/txt/msg00221.txt.bz2 Hello all, I revised the patch to add derived type support. Now it can print the nested type such like this: Type foo int4 :: a Type bar real :: b End Type bar :: x End Type foo It could also handle the member access like q%x%b. So I think it is better than before. Any more place is needed to be improved, please let me know. Here is the patch: 2005-11-16 Wu Zhou * f-exp.y: Symbol '%' is not used as modular operator in Fortran. Delete this from Fortran expression. It is now used by Fortran 95 to access the member of derived type. Add this into Fortran expression. * f-valprint.c (f_val_print): Add code to handle TYPE_CODE_STRUCT. Print each elements in the derived type. * f-typeprint.c (print_equivalent_f77_float_type): Add a parameter level into the function definition to do indented printing. And call fprintfi_filtered instead to do indented printing. (f_type_print_base): Replace fprintf_filtered with the indented version (fprintfi_filtered). (f_type_print_base): Call indented print_equivalent_f77_float_type. (f_type_print_base): Add code to handle TYPE_CODE_STRUCT. Print the definition of the derived type. Index: f-exp.y =================================================================== RCS file: /cvs/src/src/gdb/f-exp.y,v retrieving revision 1.18 diff -u -p -r1.18 f-exp.y --- f-exp.y 20 Sep 2005 06:25:34 -0000 1.18 +++ f-exp.y 16 Nov 2005 07:04:49 -0000 @@ -177,6 +177,7 @@ static int parse_number (char *, int, in %token BOOLEAN_LITERAL %token NAME %token TYPENAME +%type name %type name_not_typename /* A NAME_OR_INT is a symbol which is not known in the symbol table, @@ -216,8 +217,9 @@ static int parse_number (char *, int, in %left LSH RSH %left '@' %left '+' '-' -%left '*' '/' '%' +%left '*' '/' %right STARSTAR +%right '%' %right UNARY %right '(' @@ -331,6 +333,12 @@ exp : '(' type ')' exp %prec UNARY write_exp_elt_opcode (UNOP_CAST); } ; +exp : exp '%' name + { write_exp_elt_opcode (STRUCTOP_STRUCT); + write_exp_string ($3); + write_exp_elt_opcode (STRUCTOP_STRUCT); } + ; + /* Binary operators in order of decreasing precedence. */ exp : exp '@' exp @@ -349,10 +357,6 @@ exp : exp '/' exp { write_exp_elt_opcode (BINOP_DIV); } ; -exp : exp '%' exp - { write_exp_elt_opcode (BINOP_REM); } - ; - exp : exp '+' exp { write_exp_elt_opcode (BINOP_ADD); } ; @@ -634,6 +638,10 @@ nonempty_typelist } ; +name : NAME + { $$ = $1.stoken; } + ; + name_not_typename : NAME /* These would be useful if name_not_typename was useful, but it is just a fake for "variable", so these cause reduce/reduce conflicts because Index: f-valprint.c =================================================================== RCS file: /cvs/src/src/gdb/f-valprint.c,v retrieving revision 1.30 diff -u -p -r1.30 f-valprint.c --- f-valprint.c 9 May 2005 21:20:30 -0000 1.30 +++ f-valprint.c 16 Nov 2005 07:04:53 -0000 @@ -366,6 +366,7 @@ f_val_print (struct type *type, const gd struct type *elttype; LONGEST val; CORE_ADDR addr; + int index; CHECK_TYPEDEF (type); switch (TYPE_CODE (type)) @@ -576,6 +577,22 @@ f_val_print (struct type *type, const gd fprintf_filtered (stream, ""); break; + case TYPE_CODE_STRUCT: + /* Starting from Fortran 90 standard, Fortran language began to support + derived type. The type code is TYPE_CODE_STRUCT. */ + fprintf_filtered (stream, "{ "); + for (index = 0; index < TYPE_NFIELDS (type); index++) + { + char * field_addr = valaddr + TYPE_FIELD_BITPOS (type, index) / 8; + f_val_print (TYPE_FIELD_TYPE (type, index), field_addr, + embedded_offset, address, stream, + format, deref_ref, recurse, pretty); + if (index != TYPE_NFIELDS (type) - 1) + fputs_filtered (", ", stream); + } + fprintf_filtered (stream, "}"); + break; + default: error (_("Invalid F77 type code %d in symbol table."), TYPE_CODE (type)); } Index: f-typeprint.c =================================================================== RCS file: /cvs/src/src/gdb/f-typeprint.c,v retrieving revision 1.13 diff -u -p -r1.13 f-typeprint.c --- f-typeprint.c 11 Feb 2005 04:05:47 -0000 1.13 +++ f-typeprint.c 16 Nov 2005 07:04:55 -0000 @@ -1,7 +1,7 @@ /* Support for printing Fortran types for GDB, the GNU debugger. Copyright 1986, 1988, 1989, 1991, 1993, 1994, 1995, 1996, 1998, - 2000, 2001, 2002, 2003 Free Software Foundation, Inc. + 2000, 2001, 2002, 2003, 2005 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C version by Farooq Butt (fmbutt@engage.sps.mot.com). @@ -41,7 +41,7 @@ static void f_type_print_args (struct type *, struct ui_file *); #endif -static void print_equivalent_f77_float_type (struct type *, +static void print_equivalent_f77_float_type (int level, struct type *, struct ui_file *); static void f_type_print_varspec_suffix (struct type *, struct ui_file *, @@ -260,13 +260,13 @@ f_type_print_varspec_suffix (struct type } static void -print_equivalent_f77_float_type (struct type *type, struct ui_file *stream) +print_equivalent_f77_float_type (int level, struct type *type, struct ui_file *stream) { /* Override type name "float" and make it the appropriate real. XLC stupidly outputs -12 as a type for real when it really should be outputting -18 */ - fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type)); + fprintfi_filtered (level, stream, "real*%d", TYPE_LENGTH (type)); } /* Print the name of the type (or the ultimate pointer target, @@ -289,6 +289,8 @@ f_type_print_base (struct type *type, st int retcode; int upper_bound; + int index; + QUIT; wrap_here (" "); @@ -304,7 +306,7 @@ f_type_print_base (struct type *type, st if ((show <= 0) && (TYPE_NAME (type) != NULL)) { if (TYPE_CODE (type) == TYPE_CODE_FLT) - print_equivalent_f77_float_type (type, stream); + print_equivalent_f77_float_type (level, type, stream); else fputs_filtered (TYPE_NAME (type), stream); return; @@ -335,25 +337,25 @@ f_type_print_base (struct type *type, st break; case TYPE_CODE_VOID: - fprintf_filtered (stream, "VOID"); + fprintfi_filtered (level, stream, "VOID"); break; case TYPE_CODE_UNDEF: - fprintf_filtered (stream, "struct "); + fprintfi_filtered (level, stream, "struct "); break; case TYPE_CODE_ERROR: - fprintf_filtered (stream, ""); + fprintfi_filtered (level, stream, ""); break; case TYPE_CODE_RANGE: /* This should not occur */ - fprintf_filtered (stream, ""); + fprintfi_filtered (level, stream, ""); break; case TYPE_CODE_CHAR: /* Override name "char" and make it "character" */ - fprintf_filtered (stream, "character"); + fprintfi_filtered (level, stream, "character"); break; case TYPE_CODE_INT: @@ -362,24 +364,24 @@ f_type_print_base (struct type *type, st C-oriented, we must change these to "character" from "char". */ if (strcmp (TYPE_NAME (type), "char") == 0) - fprintf_filtered (stream, "character"); + fprintfi_filtered (level, stream, "character"); else goto default_case; break; case TYPE_CODE_COMPLEX: - fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type)); + fprintfi_filtered (level, stream, "complex*%d", TYPE_LENGTH (type)); break; case TYPE_CODE_FLT: - print_equivalent_f77_float_type (type, stream); + print_equivalent_f77_float_type (level, type, stream); break; case TYPE_CODE_STRING: /* Strings may have dynamic upperbounds (lengths) like arrays. */ if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) - fprintf_filtered (stream, "character*(*)"); + fprintfi_filtered (level, stream, "character*(*)"); else { retcode = f77_get_dynamic_upperbound (type, &upper_bound); @@ -391,6 +393,21 @@ f_type_print_base (struct type *type, st } break; + case TYPE_CODE_STRUCT: + fprintfi_filtered (level, stream, "Type "); + fputs_filtered (TYPE_TAG_NAME (type), stream); + fputs_filtered ("\n", stream); + for (index = 0; index < TYPE_NFIELDS (type); index++) + { + f_print_type (TYPE_FIELD_TYPE (type, index), "", stream, show, level + 4); + fputs_filtered (" :: ", stream); + fputs_filtered (TYPE_FIELD_NAME (type, index), stream); + fputs_filtered ("\n", stream); + } + fprintfi_filtered (level, stream, "End Type "); + fputs_filtered (TYPE_TAG_NAME (type), stream); + break; + default_case: default: /* Handle types not explicitly handled by the other cases, @@ -398,7 +415,7 @@ f_type_print_base (struct type *type, st the type name is, as recorded in the type itself. If there is no type name, then complain. */ if (TYPE_NAME (type) != NULL) - fputs_filtered (TYPE_NAME (type), stream); + fprintfi_filtered (level, stream, "%s ", TYPE_NAME (type)); else error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type)); break;