/* Support for printing Fortran values for GDB, the GNU debugger.
- Copyright 1993, 1994 Free Software Foundation, Inc.
+ Copyright 1993, 1994, 1995 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C definitions by Farooq Butt
(fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
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 "gdb_string.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "language.h"
#include "f-lang.h"
#include "frame.h"
+#include "gdbcore.h"
+#include "command.h"
-extern struct obstack dont_print_obstack;
+#if 0
+static int there_is_a_visible_common_named PARAMS ((char *));
+#endif
-extern unsigned int print_max; /* No of array elements to print */
+static void info_common_command PARAMS ((char *, int));
+static void list_all_visible_commons PARAMS ((char *));
+static void f77_print_array PARAMS ((struct type *, char *, CORE_ADDR,
+ FILE *, int, int, int,
+ enum val_prettyprint));
+static void f77_print_array_1 PARAMS ((int, int, struct type *, char *,
+ CORE_ADDR, FILE *, int, int, int,
+ enum val_prettyprint));
+static void f77_create_arrayprint_offset_tbl PARAMS ((struct type *, FILE *));
+static void f77_get_dynamic_length_of_aggregate PARAMS ((struct type *));
int f77_array_offset_tbl[MAX_FORTRAN_DIMS+1][2];
{
*lower_bound =
read_memory_integer (current_frame_addr +
- TYPE_ARRAY_LOWER_BOUND_VALUE (type),4);
+ TYPE_ARRAY_LOWER_BOUND_VALUE (type),
+ 4);
}
else
{
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:
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
{
{
*upper_bound =
read_memory_integer (current_frame_addr +
- TYPE_ARRAY_UPPER_BOUND_VALUE (type),4);
+ TYPE_ARRAY_UPPER_BOUND_VALUE (type),
+ 4);
}
else
{
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:
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
{
/* Obtain F77 adjustable array dimensions */
-void
+static void
f77_get_dynamic_length_of_aggregate (type)
struct type *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.
/* Patch in a valid length value. */
TYPE_LENGTH (type) =
- (upper_bound - lower_bound + 1) * TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+ (upper_bound - lower_bound + 1) * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
}
-/* Print a FORTRAN COMPLEX value of type TYPE, pointed to in GDB by VALADDR,
- on STREAM. which_complex indicates precision, which may be regular,
- *16, or *32 */
-
-void
-f77_print_cmplx (valaddr, type, stream, which_complex)
- char *valaddr;
- struct type *type;
- FILE *stream;
- int which_complex;
-{
- float *f1,*f2;
- double *d1, *d2;
- int i;
-
- switch (which_complex)
- {
- case TARGET_COMPLEX_BIT:
- f1 = (float *) valaddr;
- f2 = (float *) (valaddr + sizeof(float));
- fprintf_filtered (stream, "(%.7e,%.7e)", *f1, *f2);
- break;
-
- case TARGET_DOUBLE_COMPLEX_BIT:
- d1 = (double *) valaddr;
- d2 = (double *) (valaddr + sizeof(double));
- fprintf_filtered (stream, "(%.16e,%.16e)", *d1, *d2);
- break;
-#if 0
- case TARGET_EXT_COMPLEX_BIT:
- fprintf_filtered (stream, "<complex*32 format unavailable, "
- "printing raw data>\n");
-
- fprintf_filtered (stream, "( [ ");
-
- for (i = 0;i<4;i++)
- fprintf_filtered (stream, "0x%x ",
- * ( (unsigned int *) valaddr+i));
-
- fprintf_filtered (stream, "],\n [ ");
-
- for (i=4;i<8;i++)
- fprintf_filtered (stream, "0x%x ",
- * ((unsigned int *) valaddr+i));
-
- fprintf_filtered (stream, "] )");
-
- break;
-#endif
- default:
- fprintf_filtered (stream, "<cannot handle complex of this type>");
- break;
- }
-}
-
/* Function that sets up the array offset,size table for the array
- type "type". */
+ type "type". */
-void
+static void
f77_create_arrayprint_offset_tbl (type, stream)
struct type *type;
FILE *stream;
{
struct type *tmp_type;
- int eltlen;
+ int eltlen;
int ndimen = 1;
int upper, lower, retcode;
F77_DIM_SIZE (ndimen) = upper - lower + 1;
- if (ndimen == 1)
- F77_DIM_OFFSET (ndimen) = 1;
- else
- F77_DIM_OFFSET (ndimen) =
- F77_DIM_OFFSET (ndimen - 1) * F77_DIM_SIZE(ndimen - 1);
-
tmp_type = TYPE_TARGET_TYPE (tmp_type);
ndimen++;
}
- eltlen = TYPE_LENGTH (tmp_type);
-
/* Now we multiply eltlen by all the offsets, so that later we
can print out array elements correctly. Up till now we
know an offset to apply to get the item but we also
have to know how much to add to get to the next item */
- tmp_type = type;
- ndimen = 1;
-
- while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY))
+ ndimen--;
+ eltlen = TYPE_LENGTH (tmp_type);
+ F77_DIM_OFFSET (ndimen) = eltlen;
+ while (--ndimen > 0)
{
- F77_DIM_OFFSET (ndimen) *= eltlen;
- ndimen++;
- tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ eltlen *= F77_DIM_SIZE (ndimen + 1);
+ F77_DIM_OFFSET (ndimen) = eltlen;
}
}
/* Actual function which prints out F77 arrays, Valaddr == address in
the superior. Address == the address in the inferior. */
-void
+static void
f77_print_array_1 (nss, ndimensions, type, valaddr, address,
stream, format, deref_ref, recurse, pretty)
int nss;
int ndimensions;
- char *valaddr;
struct type *type;
+ char *valaddr;
CORE_ADDR address;
FILE *stream;
int format;
f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
valaddr + i * F77_DIM_OFFSET (nss),
address + i * F77_DIM_OFFSET (nss),
- stream, format, deref_ref, recurse, pretty, i);
+ stream, format, deref_ref, recurse, pretty);
fprintf_filtered (stream, ") ");
}
}
/* This function gets called to print an F77 array, we set up some
stuff and then immediately call f77_print_array_1() */
-void
+static void
f77_print_array (type, valaddr, address, stream, format, deref_ref, recurse,
pretty)
struct type *type;
int recurse;
enum val_prettyprint pretty;
{
- int array_size_array[MAX_FORTRAN_DIMS+1];
int ndimensions;
ndimensions = calc_f77_array_dims (type);
enum val_prettyprint pretty;
{
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;
CORE_ADDR addr;
+ CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
- case TYPE_CODE_LITERAL_STRING:
- /* It is trivial to print out F77 strings allocated in the
- superior process. The address field is actually a
- pointer to the bytes of the literal. For an internalvar,
- valaddr points to a ptr. which points to
- VALUE_LITERAL_DATA(value->internalvar->value)
- and for straight literals (i.e. of the form 'hello world'),
- valaddr points a ptr to VALUE_LITERAL_DATA(value). */
-
- /* First deref. valaddr */
-
- addr = * (CORE_ADDR *) valaddr;
-
- if (addr)
- {
- len = TYPE_LENGTH (type);
- localstr = alloca (len + 1);
- strncpy (localstr, addr, len);
- localstr[len] = '\0';
- fprintf_filtered (stream, "'%s'", localstr);
- }
- else
- fprintf_filtered (stream, "Unable to print literal F77 string");
- break;
-
- /* Strings are a little bit funny. They can be viewed as
- monolithic arrays that are dealt with as atomic data
- items. As such they are the only atomic data items whose
- contents are not located in the superior process. Instead
- instead of having the actual data, they contain pointers
- to addresses in the inferior where data is located. Thus
- instead of using valaddr, we use address. */
-
case TYPE_CODE_STRING:
f77_get_dynamic_length_of_aggregate (type);
- val_print_string (address, TYPE_LENGTH (type), stream);
+ LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 0);
break;
case TYPE_CODE_ARRAY:
else
{
addr = unpack_pointer (type, valaddr);
- elttype = TYPE_TARGET_TYPE (type);
+ elttype = check_typedef (TYPE_TARGET_TYPE (type));
if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
{
}
break;
- case TYPE_CODE_LITERAL_COMPLEX:
- /* We know that the literal complex is stored in the superior
- process not the inferior and that it is 16 bytes long.
- Just like the case above with a literal array, the
- 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");
-
- /* First deref. valaddr */
-
- addr = * (CORE_ADDR *) valaddr;
-
- if (addr)
- {
- fprintf_filtered (stream, "(");
-
- if (TYPE_LENGTH(type) == 16)
- {
- fprintf_filtered (stream, "%.16f", * (double *) addr);
- fprintf_filtered (stream, ", %.16f", * (double *)
- (addr + sizeof(double)));
- }
- else
- {
- fprintf_filtered (stream, "%.8f", * (float *) addr);
- fprintf_filtered (stream, ", %.8f", * (float *)
- (addr + sizeof(float)));
- }
- fprintf_filtered (stream, ") ");
- }
- else
- fprintf_filtered (stream, "Unable to print literal F77 array");
- break;
-
case TYPE_CODE_COMPLEX:
switch (TYPE_LENGTH (type))
{
- case 8:
- f77_print_cmplx (valaddr, type, stream, TARGET_COMPLEX_BIT);
- break;
-
- case 16:
- f77_print_cmplx(valaddr, type, stream, TARGET_DOUBLE_COMPLEX_BIT);
- break;
-#if 0
- case 32:
- f77_print_cmplx(valaddr, type, stream, TARGET_EXT_COMPLEX_BIT);
- break;
-#endif
+ case 8: type = builtin_type_f_real; break;
+ case 16: type = builtin_type_f_real_s8; break;
+ case 32: type = builtin_type_f_real_s16; break;
default:
error ("Cannot print out complex*%d variables", TYPE_LENGTH(type));
}
+ fputs_filtered ("(", stream);
+ print_floating (valaddr, type, stream);
+ fputs_filtered (",", stream);
+ print_floating (valaddr, type, stream);
+ fputs_filtered (")", stream);
break;
case TYPE_CODE_UNDEF:
return 0;
}
-void
+static void
list_all_visible_commons (funname)
char *funname;
{
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
funname = SYMBOL_NAME (msymbol);
}
- /* If comnname is NULL, we assume the user wishes to see the
+ /* If comname is NULL, we assume the user wishes to see the
which COMMON blocks are visible here and then return */
- if (strlen (comname) == 0)
+ if (comname == 0)
{
list_all_visible_commons (funname);
return;
/* This function is used to determine whether there is a
F77 common block visible at the current scope called 'comname'. */
-int
+#if 0
+static int
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;
return (the_common ? 1 : 0);
}
+#endif
void
_initialize_f_valprint ()
projects / deliverable / binutils-gdb.git / blobdiff