X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Ff-lang.c;h=4ee66d58c3f217dca371e13b2d37c3f87f3b515a;hb=ea377ea4c0b8e9c25328cff0240c958f82ffd311;hp=0232a548b8583e676d420c8f61660c8bfb2c74ae;hpb=acc4efdecd034e70feffeb15799745880ce2c45b;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 0232a548b8..4ee66d58c3 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -1,5 +1,5 @@ /* Fortran language support routines for GDB, the GNU debugger. - Copyright 1993, 1994 Free Software Foundation, Inc. + Copyright 1993, 1994, 1996 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C parser by Farooq Butt (fmbutt@engage.sps.mot.com). @@ -17,10 +17,10 @@ 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. */ +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include "defs.h" -#include +#include "gdb_string.h" #include "symtab.h" #include "gdbtypes.h" #include "expression.h" @@ -28,6 +28,64 @@ 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; + +/* Following is dubious stuff that had been in the xcoff reader. */ + +struct saved_fcn +{ + long line_offset; /* Line offset for function */ + struct saved_fcn *next; +}; + + +struct saved_bf_symnum +{ + long symnum_fcn; /* Symnum of function (i.e. .function directive) */ + long symnum_bf; /* Symnum of .bf for this function */ + struct saved_bf_symnum *next; +}; + +typedef struct saved_fcn SAVED_FUNCTION, *SAVED_FUNCTION_PTR; +typedef struct saved_bf_symnum SAVED_BF, *SAVED_BF_PTR; + +/* Local functions */ + +#if 0 +static void clear_function_list PARAMS ((void)); +static long get_bf_for_fcn PARAMS ((long)); +static void clear_bf_list PARAMS ((void)); +static void patch_all_commons_by_name PARAMS ((char *, CORE_ADDR, int)); +static SAVED_F77_COMMON_PTR find_first_common_named PARAMS ((char *)); +static void add_common_entry PARAMS ((struct symbol *)); +static void add_common_block PARAMS ((char *, CORE_ADDR, int, char *)); +static SAVED_FUNCTION *allocate_saved_function_node PARAMS ((void)); +static SAVED_BF_PTR allocate_saved_bf_node PARAMS ((void)); +static COMMON_ENTRY_PTR allocate_common_entry_node PARAMS ((void)); +static SAVED_F77_COMMON_PTR allocate_saved_f77_common_node PARAMS ((void)); +static void patch_common_entries PARAMS ((SAVED_F77_COMMON_PTR, CORE_ADDR, int)); +#endif + +static struct type *f_create_fundamental_type PARAMS ((struct objfile *, int)); +static void f_printstr PARAMS ((GDB_FILE *stream, char *string, unsigned int length, int width, int force_ellipses)); +static void f_printchar PARAMS ((int c, GDB_FILE *stream)); +static void f_emit_char PARAMS ((int c, GDB_FILE *stream, int quoter)); + /* 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. @@ -35,9 +93,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ be replaced with a true F77 version. */ static void -emit_char (c, stream, quoter) +f_emit_char (c, stream, quoter) register int c; - FILE *stream; + GDB_FILE *stream; int quoter; { c &= 0xFF; /* Avoid sign bit follies */ @@ -86,10 +144,10 @@ emit_char (c, stream, quoter) static void f_printchar (c, stream) int c; - FILE *stream; + GDB_FILE *stream; { fputs_filtered ("'", stream); - emit_char (c, stream, '\''); + LA_EMIT_CHAR (c, stream, '\''); fputs_filtered ("'", stream); } @@ -101,10 +159,11 @@ f_printchar (c, stream) be replaced with a true F77 version. */ static void -f_printstr (stream, string, length, force_ellipses) - FILE *stream; +f_printstr (stream, string, length, width, force_ellipses) + GDB_FILE *stream; char *string; unsigned int length; + int width; int force_ellipses; { register unsigned int i; @@ -117,7 +176,7 @@ f_printstr (stream, string, length, force_ellipses) if (length == 0) { - fputs_filtered ("''", stdout); + fputs_filtered ("''", gdb_stdout); return; } @@ -171,7 +230,7 @@ f_printstr (stream, string, length, force_ellipses) fputs_filtered ("'", stream); in_quotes = 1; } - emit_char (string[i], stream, '"'); + LA_EMIT_CHAR (string[i], stream, '"'); ++things_printed; } } @@ -318,19 +377,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,24 +435,7 @@ 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[]) = +struct type ** CONST_PTR (f_builtin_types[]) = { &builtin_type_f_character, &builtin_type_f_logical, @@ -410,7 +455,10 @@ struct type ** const (f_builtin_types[]) = 0 }; -int c_value_print(); +/* This is declared in c-lang.h but it is silly to import that file for what + is already just a hack. */ +extern int +c_value_print PARAMS ((struct value *, GDB_FILE *, int, enum val_prettyprint)); const struct language_defn f_language_defn = { "fortran", @@ -420,8 +468,10 @@ const struct language_defn f_language_defn = { type_check_on, f_parse, /* parser */ f_error, /* parser error function */ + evaluate_subexp_standard, f_printchar, /* Print character constant */ f_printstr, /* function to print string constant */ + f_emit_char, /* Function to print a single character */ f_create_fundamental_type, /* Create fundamental type in this language */ f_print_type, /* Print a type using appropriate syntax */ f_val_print, /* Print a value using appropriate syntax */ @@ -432,6 +482,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 +541,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, @@ -515,78 +569,47 @@ _initialize_f_language () add_language (&f_language_defn); } -/* Following is dubious stuff that had been in the xcoff reader. */ - -struct saved_fcn -{ - long line_offset; /* Line offset for function */ - struct saved_fcn *next; -}; - - -struct saved_bf_symnum -{ - long symnum_fcn; /* Symnum of function (i.e. .function directive) */ - long symnum_bf; /* Symnum of .bf for this function */ - struct saved_bf_symnum *next; -}; - -typedef struct saved_fcn SAVED_FUNCTION, *SAVED_FUNCTION_PTR; -typedef struct saved_bf_symnum SAVED_BF, *SAVED_BF_PTR; - - -SAVED_BF_PTR allocate_saved_bf_node() +#if 0 +static SAVED_BF_PTR +allocate_saved_bf_node() { SAVED_BF_PTR new; - new = (SAVED_BF_PTR) malloc (sizeof (SAVED_BF)); - - if (new == NULL) - fatal("could not allocate enough memory to save one more .bf on save list"); + new = (SAVED_BF_PTR) xmalloc (sizeof (SAVED_BF)); return(new); } -SAVED_FUNCTION *allocate_saved_function_node() +static SAVED_FUNCTION * +allocate_saved_function_node() { SAVED_FUNCTION *new; - new = (SAVED_FUNCTION *) malloc (sizeof (SAVED_FUNCTION)); - - if (new == NULL) - fatal("could not allocate enough memory to save one more function on save list"); - + new = (SAVED_FUNCTION *) xmalloc (sizeof (SAVED_FUNCTION)); return(new); } -SAVED_F77_COMMON_PTR allocate_saved_f77_common_node() +static SAVED_F77_COMMON_PTR allocate_saved_f77_common_node() { SAVED_F77_COMMON_PTR new; - new = (SAVED_F77_COMMON_PTR) malloc (sizeof (SAVED_F77_COMMON)); - - if (new == NULL) - fatal("could not allocate enough memory to save one more F77 COMMON blk on save list"); - + new = (SAVED_F77_COMMON_PTR) xmalloc (sizeof (SAVED_F77_COMMON)); return(new); } -COMMON_ENTRY_PTR allocate_common_entry_node() +static COMMON_ENTRY_PTR allocate_common_entry_node() { COMMON_ENTRY_PTR new; - new = (COMMON_ENTRY_PTR) malloc (sizeof (COMMON_ENTRY)); - - if (new == NULL) - fatal("could not allocate enough memory to save one more COMMON entry on save list"); - + new = (COMMON_ENTRY_PTR) xmalloc (sizeof (COMMON_ENTRY)); return(new); } - +#endif SAVED_F77_COMMON_PTR head_common_list=NULL; /* Ptr to 1st saved COMMON */ SAVED_F77_COMMON_PTR tail_common_list=NULL; /* Ptr to last saved COMMON */ SAVED_F77_COMMON_PTR current_common=NULL; /* Ptr to current COMMON */ +#if 0 static SAVED_BF_PTR saved_bf_list=NULL; /* Ptr to (.bf,function) list*/ static SAVED_BF_PTR saved_bf_list_end=NULL; /* Ptr to above list's end */ @@ -596,16 +619,15 @@ static SAVED_BF_PTR current_head_bf_list=NULL; /* Current head of above list static SAVED_BF_PTR tmp_bf_ptr; /* Generic temporary for use in macros */ - /* The following function simply enters a given common block onto the global common block chain */ -void add_common_block(name,offset,secnum,func_stab) +static void +add_common_block(name,offset,secnum,func_stab) char *name; CORE_ADDR offset; int secnum; char *func_stab; - { SAVED_F77_COMMON_PTR tmp; char *c,*local_copy_func_stab; @@ -627,10 +649,10 @@ void add_common_block(name,offset,secnum,func_stab) tmp = allocate_saved_f77_common_node(); - local_copy_func_stab = malloc (strlen(func_stab) + 1); + local_copy_func_stab = xmalloc (strlen(func_stab) + 1); strcpy(local_copy_func_stab,func_stab); - tmp->name = malloc(strlen(name) + 1); + tmp->name = xmalloc(strlen(name) + 1); /* local_copy_func_stab is a stabstring, let us first extract the function name from the stab by NULLing out the ':' character. */ @@ -645,7 +667,7 @@ void add_common_block(name,offset,secnum,func_stab) error("Malformed function STAB found in add_common_block()"); - tmp->owning_function = malloc (strlen(local_copy_func_stab) + 1); + tmp->owning_function = xmalloc (strlen(local_copy_func_stab) + 1); strcpy(tmp->owning_function,local_copy_func_stab); @@ -666,14 +688,15 @@ void add_common_block(name,offset,secnum,func_stab) tail_common_list->next = tmp; tail_common_list = tmp; } - } - +#endif /* The following function simply enters a given common entry onto the "current_common" block that has been saved away. */ -void add_common_entry(entry_sym_ptr) +#if 0 +static void +add_common_entry(entry_sym_ptr) struct symbol *entry_sym_ptr; { COMMON_ENTRY_PTR tmp; @@ -704,13 +727,14 @@ void add_common_entry(entry_sym_ptr) current_common->end_of_entries = tmp; } } - - } +#endif /* This routine finds the first encountred COMMON block named "name" */ -SAVED_F77_COMMON_PTR find_first_common_named(name) +#if 0 +static SAVED_F77_COMMON_PTR +find_first_common_named(name) char *name; { @@ -727,6 +751,7 @@ SAVED_F77_COMMON_PTR find_first_common_named(name) } return(NULL); } +#endif /* This routine finds the first encountred COMMON block named "name" that belongs to function funcname */ @@ -751,14 +776,14 @@ SAVED_F77_COMMON_PTR find_common_for_function(name, funcname) } - +#if 0 /* The following function is called to patch up the offsets for the statics contained in the COMMON block named "name." */ - -void patch_common_entries (blk, offset, secnum) +static void +patch_common_entries (blk, offset, secnum) SAVED_F77_COMMON_PTR blk; CORE_ADDR offset; int secnum; @@ -779,15 +804,14 @@ void patch_common_entries (blk, offset, secnum) blk->secnum = secnum; } - /* Patch all commons named "name" that need patching.Since COMMON blocks occur with relative infrequency, we simply do a linear scan on the name. Eventually, the best way to do this will be a hashed-lookup. Secnum is the section number for the .bss section (which is where common data lives). */ - -void patch_all_commons_by_name (name, offset, secnum) +static void +patch_all_commons_by_name (name, offset, secnum) char *name; CORE_ADDR offset; int secnum; @@ -816,12 +840,8 @@ void patch_all_commons_by_name (name, offset, secnum) tmp = tmp->next; } - } - - - - +#endif /* This macro adds the symbol-number for the start of the function (the symbol number of the .bf) referenced by symnum_fcn to a @@ -831,6 +851,7 @@ void patch_all_commons_by_name (name, offset, secnum) first by a queueing algorithm and upon failure fall back to a linear scan. */ +#if 0 #define ADD_BF_SYMNUM(bf_sym,fcn_sym) \ \ if (saved_bf_list == NULL) \ @@ -855,11 +876,12 @@ else \ saved_bf_list_end->next = tmp_bf_ptr; \ saved_bf_list_end = tmp_bf_ptr; \ } - +#endif /* This function frees the entire (.bf,function) list */ -void +#if 0 +static void clear_bf_list() { @@ -874,10 +896,13 @@ void } saved_bf_list = NULL; } +#endif int global_remote_debug; -long +#if 0 + +static long get_bf_for_fcn (the_function) long the_function; { @@ -929,7 +954,8 @@ get_bf_for_fcn (the_function) static SAVED_FUNCTION_PTR saved_function_list=NULL; static SAVED_FUNCTION_PTR saved_function_list_end=NULL; -void clear_function_list() +static void +clear_function_list() { SAVED_FUNCTION_PTR tmp = saved_function_list; SAVED_FUNCTION_PTR next = NULL; @@ -943,3 +969,5 @@ void clear_function_list() saved_function_list = NULL; } +#endif +