diff options
author | Stan Shebs <shebs@codesourcery.com> | 1994-08-19 21:59:05 +0000 |
---|---|---|
committer | Stan Shebs <shebs@codesourcery.com> | 1994-08-19 21:59:05 +0000 |
commit | a91a61923d82c39ebeb9971635b76c7da494cab4 (patch) | |
tree | 5d26199b5455ca2369b432d008da29521e861908 /gdb/f-typeprint.c | |
parent | f3806e3b6ceead276a3acba85ff944fde6668e39 (diff) | |
download | fsf-binutils-gdb-a91a61923d82c39ebeb9971635b76c7da494cab4.zip fsf-binutils-gdb-a91a61923d82c39ebeb9971635b76c7da494cab4.tar.gz fsf-binutils-gdb-a91a61923d82c39ebeb9971635b76c7da494cab4.tar.bz2 |
Initial Fortran language support, adapted from work by Farooq Butt
(fmbutt@engage.sps.mot.com).
* Makefile.in: Add Fortran-related files and dependencies.
* defs.h (language_fortran): New language enum.
* language.h (_LANG_fortran): Define.
(MAX_FORTRAN_DIMS): Define.
* expression.h: Reformat to standard.
(MULTI_F77_SUBSCRIPT, OP_F77_UNDETERMINED_ARGLIST,
OP_F77_LITERAL_COMPLEX, OP_F77_SUBSTR): New expression opcodes.
* gdbtypes.h (TYPE_CODE_COMPLEX, TYPE_CODE_LITERAL_COMPLEX,
TYPE_CODE_LITERAL_STRING): New type codes.
(type): New fields upper_bound_type and lower_bound_type.
(TYPE_ARRAY_UPPER_BOUND_TYPE, TYPE_ARRAY_LOWER_BOUND_TYPE,
TYPE_ARRAY_UPPER_BOUND_VALUE, TYPE_ARRAY_LOWER_BOUND_VALUE): New
macros.
(builtin_type_f_character, etc): Declare.
* value.h (VALUE_LITERAL_DATA, VALUE_SUBSTRING_START): Define.
* f-exp.y: New file, Fortran expression grammar.
* f-lang.c: New file, Fortran language support functions.
* f-lang.h: New file, Fortran language support declarations.
* f-typeprint.c: New file, Fortran type printing.
* f-valprint.c: New file, Fortran value printing.
* eval.c (evaluate_subexp): Add code for new expression opcodes,
fix wording of error message.
* gdbtypes.c (f77_create_literal_complex_type,
f77_create_literal_string_type): New functions.
* language.c (set_language_command): Add Fortran info.
(calc_f77_array_dims): New function.
* parse.c (length_of_subexp, prefixify_subexp): Add cases for new
expression opcodes.
* symfile.c (deduce_language_from_filename): Recognize .f and .F
as Fortran source files.
* valops.c (f77_value_literal_string, f77_value_substring,
f77_value_literal_complex): New functions.
Diffstat (limited to 'gdb/f-typeprint.c')
-rw-r--r-- | gdb/f-typeprint.c | 457 |
1 files changed, 457 insertions, 0 deletions
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c new file mode 100644 index 0000000..3540f48 --- /dev/null +++ b/gdb/f-typeprint.c @@ -0,0 +1,457 @@ +/* Support for printing Fortran types for GDB, the GNU debugger. + Copyright 1986, 1988, 1989, 1991 Free Software Foundation, Inc. + Contributed by Motorola. Adapted from the C version by Farooq Butt + (fmbutt@engage.sps.mot.com). + +This file is part of GDB. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ + +#include "defs.h" +#include "obstack.h" +#include "bfd.h" +#include "symtab.h" +#include "gdbtypes.h" +#include "expression.h" +#include "value.h" +#include "gdbcore.h" +#include "target.h" +#include "command.h" +#include "gdbcmd.h" +#include "language.h" +#include "demangle.h" +#include "f-lang.h" +#include "typeprint.h" +#include "frame.h" /* ??? */ + +#include <string.h> +#include <errno.h> + +static void f_type_print_args PARAMS ((struct type *, FILE *)); + +static void f_type_print_varspec_suffix PARAMS ((struct type *, FILE *, + int, int, int)); + +void f_type_print_varspec_prefix PARAMS ((struct type *, FILE *, int, int)); + +void f_type_print_base PARAMS ((struct type *, FILE *, int, int)); + + +/* LEVEL is the depth to indent lines by. */ + +void +f_print_type (type, varstring, stream, show, level) + struct type *type; + char *varstring; + FILE *stream; + int show; + int level; +{ + register enum type_code code; + int demangled_args; + + f_type_print_base (type, stream, show, level); + code = TYPE_CODE (type); + if ((varstring != NULL && *varstring != '\0') + || + /* Need a space if going to print stars or brackets; + but not if we will print just a type name. */ + ((show > 0 || TYPE_NAME (type) == 0) + && + (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC + || code == TYPE_CODE_METHOD + || code == TYPE_CODE_ARRAY + || code == TYPE_CODE_MEMBER + || code == TYPE_CODE_REF))) + fputs_filtered (" ", stream); + f_type_print_varspec_prefix (type, stream, show, 0); + + fputs_filtered (varstring, stream); + + /* For demangled function names, we have the arglist as part of the name, + so don't print an additional pair of ()'s */ + + demangled_args = varstring[strlen(varstring) - 1] == ')'; + f_type_print_varspec_suffix (type, stream, show, 0, demangled_args); +} + +/* Print any asterisks or open-parentheses needed before the + variable name (to describe its type). + + On outermost call, pass 0 for PASSED_A_PTR. + On outermost call, SHOW > 0 means should ignore + any typename for TYPE and show its details. + SHOW is always zero on recursive calls. */ + +void +f_type_print_varspec_prefix (type, stream, show, passed_a_ptr) + struct type *type; + FILE *stream; + int show; + int passed_a_ptr; +{ + char *name; + if (type == 0) + return; + + if (TYPE_NAME (type) && show <= 0) + return; + + QUIT; + + switch (TYPE_CODE (type)) + { + case TYPE_CODE_PTR: + f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1); + break; + + case TYPE_CODE_FUNC: + f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); + if (passed_a_ptr) + fprintf_filtered (stream, "("); + break; + + case TYPE_CODE_ARRAY: + f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); + break; + + case TYPE_CODE_UNDEF: + case TYPE_CODE_STRUCT: + case TYPE_CODE_UNION: + case TYPE_CODE_ENUM: + case TYPE_CODE_INT: + case TYPE_CODE_FLT: + case TYPE_CODE_VOID: + case TYPE_CODE_ERROR: + case TYPE_CODE_CHAR: + case TYPE_CODE_BOOL: + case TYPE_CODE_SET: + case TYPE_CODE_RANGE: + case TYPE_CODE_STRING: + /* These types need no prefix. They are listed here so that + gcc -Wall will reveal any types that haven't been handled. */ + break; + } +} + +static void +f_type_print_args (type, stream) + struct type *type; + FILE *stream; +{ + int i; + struct type **args; + + fprintf_filtered (stream, "("); + args = TYPE_ARG_TYPES (type); + if (args != NULL) + { + if (args[1] == NULL) + { + fprintf_filtered (stream, "..."); + } + else + { + for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++) + { + f_print_type (args[i], "", stream, -1, 0); + if (args[i+1] == NULL) + fprintf_filtered (stream, "..."); + else if (args[i+1]->code != TYPE_CODE_VOID) + { + fprintf_filtered (stream, ","); + wrap_here (" "); + } + } + } + } + fprintf_filtered (stream, ")"); +} + +/* Print any array sizes, function arguments or close parentheses + needed after the variable name (to describe its type). + Args work like c_type_print_varspec_prefix. */ + +static void +f_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args) + struct type *type; + FILE *stream; + int show; + int passed_a_ptr; + int demangled_args; +{ + CORE_ADDR current_frame_addr = 0; + int upper_bound,lower_bound; + int lower_bound_was_default = 0; + static int arrayprint_recurse_level = 0; + int retcode; + + if (type == 0) + return; + + if (TYPE_NAME (type) && show <= 0) + return; + + QUIT; + + switch (TYPE_CODE (type)) + { + case TYPE_CODE_ARRAY: + arrayprint_recurse_level++; + + if (arrayprint_recurse_level == 1) + fprintf_filtered(stream,"("); + else + fprintf_filtered(stream,","); + + retcode = f77_get_dynamic_lowerbound (type,&lower_bound); + + lower_bound_was_default = 0; + + if (retcode == BOUND_FETCH_ERROR) + fprintf_filtered (stream,"???"); + else + if (lower_bound == 1) /* The default */ + lower_bound_was_default = 1; + else + fprintf_filtered (stream,"%d",lower_bound); + + if (lower_bound_was_default) + lower_bound_was_default = 0; + else + fprintf_filtered(stream,":"); + + /* Make sure that, if we have an assumed size array, we + print out a warning and print the upperbound as '*' */ + + if (TYPE_ARRAY_UPPER_BOUND_TYPE(type) == BOUND_CANNOT_BE_DETERMINED) + fprintf_filtered (stream, "*"); + else + { + retcode = f77_get_dynamic_upperbound(type,&upper_bound); + + if (retcode == BOUND_FETCH_ERROR) + fprintf_filtered(stream,"???"); + else + fprintf_filtered(stream,"%d",upper_bound); + } + + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); + if (arrayprint_recurse_level == 1) + fprintf_filtered (stream, ")"); + arrayprint_recurse_level--; + break; + + case TYPE_CODE_PTR: + case TYPE_CODE_REF: + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0); + fprintf_filtered(stream,")"); + break; + + case TYPE_CODE_FUNC: + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + passed_a_ptr, 0); + if (passed_a_ptr) + fprintf_filtered (stream, ")"); + + fprintf_filtered (stream, "()"); + break; + + case TYPE_CODE_UNDEF: + case TYPE_CODE_STRUCT: + case TYPE_CODE_UNION: + case TYPE_CODE_ENUM: + case TYPE_CODE_INT: + case TYPE_CODE_FLT: + case TYPE_CODE_VOID: + case TYPE_CODE_ERROR: + case TYPE_CODE_CHAR: + case TYPE_CODE_BOOL: + case TYPE_CODE_SET: + case TYPE_CODE_RANGE: + case TYPE_CODE_LITERAL_STRING: + case TYPE_CODE_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; + 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 */ + + switch (TYPE_LENGTH (type)) + { + case 4: + fprintf_filtered (stream, "real*4"); + break; + + case 8: + fprintf_filtered(stream,"real*8"); + break; + } +} + +/* Print the name of the type (or the ultimate pointer target, + function value or array element), or the description of a + structure or union. + + SHOW nonzero means don't print this type as just its name; + show its real definition even if it has a name. + SHOW zero means print just typename or struct tag if there is one + SHOW negative means abbreviate structure elements. + SHOW is decremented for printing of structure elements. + + LEVEL is the depth to indent by. + We increase it for some recursive calls. */ + +void +f_type_print_base (type, stream, show, level) + struct type *type; + FILE *stream; + 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; + QUIT; + + wrap_here (" "); + if (type == NULL) + { + fputs_filtered ("<type unknown>", stream); + return; + } + + /* When SHOW is zero or less, and there is a valid type name, then always + just print the type name directly from the type. */ + + 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 + fputs_filtered (TYPE_NAME (type), stream); + return; + } + + switch (TYPE_CODE (type)) + { + case TYPE_CODE_ARRAY: + f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); + break; + + case TYPE_CODE_FUNC: + f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); + break; + + case TYPE_CODE_PTR: + fprintf_filtered (stream, "PTR TO -> ( "); + f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level); + break; + + case TYPE_CODE_VOID: + fprintf_filtered (stream, "VOID"); + break; + + case TYPE_CODE_UNDEF: + fprintf_filtered (stream, "struct <unknown>"); + break; + + case TYPE_CODE_ERROR: + fprintf_filtered (stream, "<unknown type>"); + break; + + case TYPE_CODE_RANGE: + /* This should not occur */ + fprintf_filtered (stream, "<range type>"); + break; + + case TYPE_CODE_CHAR: + /* Override name "char" and make it "character" */ + fprintf_filtered (stream, "character"); + break; + + case TYPE_CODE_INT: + /* There may be some character types that attempt to come + 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"); + 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)); + break; + + case TYPE_CODE_FLT: + 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 */ + + if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) + fprintf_filtered("character*(*)"); + else + { + retcode = f77_get_dynamic_upperbound(type,&upper_bound); + + if (retcode == BOUND_FETCH_ERROR) + fprintf_filtered(stream,"character*???"); + else + fprintf_filtered(stream,"character*%d",upper_bound); + } + break; + + default_case: + default: + /* Handle types not explicitly handled by the other cases, + such as fundamental types. For these, just print whatever + 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); + else + error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type)); + break; + } +} |