darlinghq/darling-gdb
1
0
Fork 0
mirror of https://github.com/darlinghq/darling-gdb.git synced 2024-11-28 14:30:48 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

* c-typeprint.c (c_type_print_varspec_prefix,

Browse Source 
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 <string.h>, move include of parser-defs.h.
	 (parse_number): Translate 'd' floats to 'e' so atof() works.
	 (yylex): Remove unused variables.
	 * f-lang.c: Include <string.h>.
	 (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.
This commit is contained in:
Stan Shebs 1994-09-07 00:23:16 +00:00
parent 6ceff8e7d2
commit 22d7f91e32
6 changed files with 110 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gdb/ChangeLog
View File

@ -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 <string.h>, move include of parser-defs.h.
(parse_number): Translate 'd' floats to 'e' so atof() works.
(yylex): Remove unused variables.
* f-lang.c: Include <string.h>.
(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

6
gdb/c-typeprint.c
View File

@ -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;

42
gdb/f-exp.y
View File

@ -43,9 +43,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
%{
#include "defs.h"
#include <string.h>
#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. */

2
gdb/f-lang.c
View File

@ -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 <string.h>
#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) */

55
gdb/f-typeprint.c
View File

@ -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;

49
gdb/f-valprint.c
View File

@ -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 <string.h>
#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)
{
@ -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 *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;