GDB (xrefs)
/tmp/gdb-7.10/gdb/f-valprint.c
Go to the documentation of this file.
1 /* Support for printing Fortran values for GDB, the GNU debugger.
2 
3  Copyright (C) 1993-2015 Free Software Foundation, Inc.
4 
5  Contributed by Motorola. Adapted from the C definitions by Farooq Butt
6  (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
7 
8  This file is part of GDB.
9 
10  This program is free software; you can redistribute it and/or modify
11  it under the terms of the GNU General Public License as published by
12  the Free Software Foundation; either version 3 of the License, or
13  (at your option) any later version.
14 
15  This program is distributed in the hope that it will be useful,
16  but WITHOUT ANY WARRANTY; without even the implied warranty of
17  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18  GNU General Public License for more details.
19 
20  You should have received a copy of the GNU General Public License
21  along with this program. If not, see <http://www.gnu.org/licenses/>. */
22 
23 #include "defs.h"
24 #include "symtab.h"
25 #include "gdbtypes.h"
26 #include "expression.h"
27 #include "value.h"
28 #include "valprint.h"
29 #include "language.h"
30 #include "f-lang.h"
31 #include "frame.h"
32 #include "gdbcore.h"
33 #include "command.h"
34 #include "block.h"
35 #include "dictionary.h"
36 
37 extern void _initialize_f_valprint (void);
38 static void info_common_command (char *, int);
39 static void f77_create_arrayprint_offset_tbl (struct type *,
40  struct ui_file *);
41 static void f77_get_dynamic_length_of_aggregate (struct type *);
42 
44 
45 /* Array which holds offsets to be applied to get a row's elements
46  for a given array. Array also holds the size of each subarray. */
47 
48 /* The following macro gives us the size of the nth dimension, Where
49  n is 1 based. */
50 
51 #define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
52 
53 /* The following gives us the offset for row n where n is 1-based. */
54 
55 #define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
56 
57 int
59 {
61  error (_("Lower bound may not be '*' in F77"));
62 
63  return TYPE_ARRAY_LOWER_BOUND_VALUE (type);
64 }
65 
66 int
68 {
70  {
71  /* We have an assumed size array on our hands. Assume that
72  upper_bound == lower_bound so that we show at least 1 element.
73  If the user wants to see more elements, let him manually ask for 'em
74  and we'll subscript the array and show him. */
75 
76  return f77_get_lowerbound (type);
77  }
78 
79  return TYPE_ARRAY_UPPER_BOUND_VALUE (type);
80 }
81 
82 /* Obtain F77 adjustable array dimensions. */
83 
84 static void
86 {
87  int upper_bound = -1;
88  int lower_bound = 1;
89 
90  /* Recursively go all the way down into a possibly multi-dimensional
91  F77 array and get the bounds. For simple arrays, this is pretty
92  easy but when the bounds are dynamic, we must be very careful
93  to add up all the lengths correctly. Not doing this right
94  will lead to horrendous-looking arrays in parameter lists.
95 
96  This function also works for strings which behave very
97  similarly to arrays. */
98 
102 
103  /* Recursion ends here, start setting up lengths. */
104  lower_bound = f77_get_lowerbound (type);
105  upper_bound = f77_get_upperbound (type);
106 
107  /* Patch in a valid length value. */
108 
109  TYPE_LENGTH (type) =
110  (upper_bound - lower_bound + 1)
112 }
113 
114 /* Function that sets up the array offset,size table for the array
115  type "type". */
116 
117 static void
119 {
120  struct type *tmp_type;
121  int eltlen;
122  int ndimen = 1;
123  int upper, lower;
124 
125  tmp_type = type;
126 
127  while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
128  {
129  upper = f77_get_upperbound (tmp_type);
130  lower = f77_get_lowerbound (tmp_type);
131 
132  F77_DIM_SIZE (ndimen) = upper - lower + 1;
133 
134  tmp_type = TYPE_TARGET_TYPE (tmp_type);
135  ndimen++;
136  }
137 
138  /* Now we multiply eltlen by all the offsets, so that later we
139  can print out array elements correctly. Up till now we
140  know an offset to apply to get the item but we also
141  have to know how much to add to get to the next item. */
142 
143  ndimen--;
144  eltlen = TYPE_LENGTH (tmp_type);
145  F77_DIM_OFFSET (ndimen) = eltlen;
146  while (--ndimen > 0)
147  {
148  eltlen *= F77_DIM_SIZE (ndimen + 1);
149  F77_DIM_OFFSET (ndimen) = eltlen;
150  }
151 }
152 
153 
154 
155 /* Actual function which prints out F77 arrays, Valaddr == address in
156  the superior. Address == the address in the inferior. */
157 
158 static void
159 f77_print_array_1 (int nss, int ndimensions, struct type *type,
160  const gdb_byte *valaddr,
161  int embedded_offset, CORE_ADDR address,
162  struct ui_file *stream, int recurse,
163  const struct value *val,
164  const struct value_print_options *options,
165  int *elts)
166 {
167  int i;
168 
169  if (nss != ndimensions)
170  {
171  for (i = 0;
172  (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max);
173  i++)
174  {
175  fprintf_filtered (stream, "( ");
176  f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
177  valaddr,
178  embedded_offset + i * F77_DIM_OFFSET (nss),
179  address,
180  stream, recurse, val, options, elts);
181  fprintf_filtered (stream, ") ");
182  }
183  if (*elts >= options->print_max && i < F77_DIM_SIZE (nss))
184  fprintf_filtered (stream, "...");
185  }
186  else
187  {
188  for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
189  i++, (*elts)++)
190  {
191  val_print (TYPE_TARGET_TYPE (type),
192  valaddr,
193  embedded_offset + i * F77_DIM_OFFSET (ndimensions),
194  address, stream, recurse,
195  val, options, current_language);
196 
197  if (i != (F77_DIM_SIZE (nss) - 1))
198  fprintf_filtered (stream, ", ");
199 
200  if ((*elts == options->print_max - 1)
201  && (i != (F77_DIM_SIZE (nss) - 1)))
202  fprintf_filtered (stream, "...");
203  }
204  }
205 }
206 
207 /* This function gets called to print an F77 array, we set up some
208  stuff and then immediately call f77_print_array_1(). */
209 
210 static void
211 f77_print_array (struct type *type, const gdb_byte *valaddr,
212  int embedded_offset,
213  CORE_ADDR address, struct ui_file *stream,
214  int recurse,
215  const struct value *val,
216  const struct value_print_options *options)
217 {
218  int ndimensions;
219  int elts = 0;
220 
221  ndimensions = calc_f77_array_dims (type);
222 
223  if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
224  error (_("\
225 Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
226  ndimensions, MAX_FORTRAN_DIMS);
227 
228  /* Since F77 arrays are stored column-major, we set up an
229  offset table to get at the various row's elements. The
230  offset table contains entries for both offset and subarray size. */
231 
232  f77_create_arrayprint_offset_tbl (type, stream);
233 
234  f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
235  address, stream, recurse, val, options, &elts);
236 }
237 
238 
239 /* Decorations for Fortran. */
240 
241 static const struct generic_val_print_decorations f_decorations =
242 {
243  "(",
244  ",",
245  ")",
246  ".TRUE.",
247  ".FALSE.",
248  "VOID",
249 };
250 
251 /* See val_print for a description of the various parameters of this
252  function; they are identical. */
253 
254 void
255 f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
256  CORE_ADDR address, struct ui_file *stream, int recurse,
257  const struct value *original_value,
258  const struct value_print_options *options)
259 {
260  struct gdbarch *gdbarch = get_type_arch (type);
261  enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
262  unsigned int i = 0; /* Number of characters printed. */
263  struct type *elttype;
264  CORE_ADDR addr;
265  int index;
266 
267  CHECK_TYPEDEF (type);
268  switch (TYPE_CODE (type))
269  {
270  case TYPE_CODE_STRING:
272  LA_PRINT_STRING (stream, builtin_type (gdbarch)->builtin_char,
273  valaddr + embedded_offset,
274  TYPE_LENGTH (type), NULL, 0, options);
275  break;
276 
277  case TYPE_CODE_ARRAY:
278  if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_CHAR)
279  {
280  fprintf_filtered (stream, "(");
281  f77_print_array (type, valaddr, embedded_offset,
282  address, stream, recurse, original_value, options);
283  fprintf_filtered (stream, ")");
284  }
285  else
286  {
287  struct type *ch_type = TYPE_TARGET_TYPE (type);
288 
290  LA_PRINT_STRING (stream, ch_type,
291  valaddr + embedded_offset,
292  TYPE_LENGTH (type) / TYPE_LENGTH (ch_type),
293  NULL, 0, options);
294  }
295  break;
296 
297  case TYPE_CODE_PTR:
298  if (options->format && options->format != 's')
299  {
300  val_print_scalar_formatted (type, valaddr, embedded_offset,
301  original_value, options, 0, stream);
302  break;
303  }
304  else
305  {
306  int want_space = 0;
307 
308  addr = unpack_pointer (type, valaddr + embedded_offset);
309  elttype = check_typedef (TYPE_TARGET_TYPE (type));
310 
311  if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
312  {
313  /* Try to print what function it points to. */
314  print_function_pointer_address (options, gdbarch, addr, stream);
315  return;
316  }
317 
318  if (options->symbol_print)
319  want_space = print_address_demangle (options, gdbarch, addr,
320  stream, demangle);
321  else if (options->addressprint && options->format != 's')
322  {
323  fputs_filtered (paddress (gdbarch, addr), stream);
324  want_space = 1;
325  }
326 
327  /* For a pointer to char or unsigned char, also print the string
328  pointed to, unless pointer is null. */
329  if (TYPE_LENGTH (elttype) == 1
330  && TYPE_CODE (elttype) == TYPE_CODE_INT
331  && (options->format == 0 || options->format == 's')
332  && addr != 0)
333  {
334  if (want_space)
335  fputs_filtered (" ", stream);
336  i = val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
337  stream, options);
338  }
339  return;
340  }
341  break;
342 
343  case TYPE_CODE_INT:
344  if (options->format || options->output_format)
345  {
346  struct value_print_options opts = *options;
347 
348  opts.format = (options->format ? options->format
349  : options->output_format);
350  val_print_scalar_formatted (type, valaddr, embedded_offset,
351  original_value, &opts, 0, stream);
352  }
353  else
354  {
355  val_print_type_code_int (type, valaddr + embedded_offset, stream);
356  /* C and C++ has no single byte int type, char is used instead.
357  Since we don't know whether the value is really intended to
358  be used as an integer or a character, print the character
359  equivalent as well. */
360  if (TYPE_LENGTH (type) == 1)
361  {
362  LONGEST c;
363 
364  fputs_filtered (" ", stream);
365  c = unpack_long (type, valaddr + embedded_offset);
366  LA_PRINT_CHAR ((unsigned char) c, type, stream);
367  }
368  }
369  break;
370 
371  case TYPE_CODE_STRUCT:
372  case TYPE_CODE_UNION:
373  /* Starting from the Fortran 90 standard, Fortran supports derived
374  types. */
375  fprintf_filtered (stream, "( ");
376  for (index = 0; index < TYPE_NFIELDS (type); index++)
377  {
378  int offset = TYPE_FIELD_BITPOS (type, index) / 8;
379 
380  val_print (TYPE_FIELD_TYPE (type, index), valaddr,
381  embedded_offset + offset,
382  address, stream, recurse + 1,
383  original_value, options, current_language);
384  if (index != TYPE_NFIELDS (type) - 1)
385  fputs_filtered (", ", stream);
386  }
387  fprintf_filtered (stream, " )");
388  break;
389 
390  case TYPE_CODE_REF:
391  case TYPE_CODE_FUNC:
392  case TYPE_CODE_FLAGS:
393  case TYPE_CODE_FLT:
394  case TYPE_CODE_VOID:
395  case TYPE_CODE_ERROR:
396  case TYPE_CODE_RANGE:
397  case TYPE_CODE_UNDEF:
398  case TYPE_CODE_COMPLEX:
399  case TYPE_CODE_BOOL:
400  case TYPE_CODE_CHAR:
401  default:
402  generic_val_print (type, valaddr, embedded_offset, address,
403  stream, recurse, original_value, options,
404  &f_decorations);
405  break;
406  }
407  gdb_flush (stream);
408 }
409 
410 static void
411 info_common_command_for_block (const struct block *block, const char *comname,
412  int *any_printed)
413 {
414  struct block_iterator iter;
415  struct symbol *sym;
416  const char *name;
417  struct value_print_options opts;
418 
419  get_user_print_options (&opts);
420 
421  ALL_BLOCK_SYMBOLS (block, iter, sym)
422  if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
423  {
424  const struct common_block *common = SYMBOL_VALUE_COMMON_BLOCK (sym);
425  size_t index;
426 
428 
429  if (comname && (!SYMBOL_LINKAGE_NAME (sym)
430  || strcmp (comname, SYMBOL_LINKAGE_NAME (sym)) != 0))
431  continue;
432 
433  if (*any_printed)
434  putchar_filtered ('\n');
435  else
436  *any_printed = 1;
437  if (SYMBOL_PRINT_NAME (sym))
438  printf_filtered (_("Contents of F77 COMMON block '%s':\n"),
439  SYMBOL_PRINT_NAME (sym));
440  else
441  printf_filtered (_("Contents of blank COMMON block:\n"));
442 
443  for (index = 0; index < common->n_entries; index++)
444  {
445  struct value *val = NULL;
446 
447  printf_filtered ("%s = ",
448  SYMBOL_PRINT_NAME (common->contents[index]));
449 
450  TRY
451  {
452  val = value_of_variable (common->contents[index], block);
453  value_print (val, gdb_stdout, &opts);
454  }
455 
456  CATCH (except, RETURN_MASK_ERROR)
457  {
458  printf_filtered ("<error reading variable: %s>", except.message);
459  }
460  END_CATCH
461 
462  putchar_filtered ('\n');
463  }
464  }
465 }
466 
467 /* This function is used to print out the values in a given COMMON
468  block. It will always use the most local common block of the
469  given name. */
470 
471 static void
472 info_common_command (char *comname, int from_tty)
473 {
474  struct frame_info *fi;
475  const struct block *block;
476  int values_printed = 0;
477 
478  /* We have been told to display the contents of F77 COMMON
479  block supposedly visible in this function. Let us
480  first make sure that it is visible and if so, let
481  us display its contents. */
482 
483  fi = get_selected_frame (_("No frame selected"));
484 
485  /* The following is generally ripped off from stack.c's routine
486  print_frame_info(). */
487 
488  block = get_frame_block (fi, 0);
489  if (block == NULL)
490  {
491  printf_filtered (_("No symbol table info available.\n"));
492  return;
493  }
494 
495  while (block)
496  {
497  info_common_command_for_block (block, comname, &values_printed);
498  /* After handling the function's top-level block, stop. Don't
499  continue to its superblock, the block of per-file symbols. */
500  if (BLOCK_FUNCTION (block))
501  break;
502  block = BLOCK_SUPERBLOCK (block);
503  }
504 
505  if (!values_printed)
506  {
507  if (comname)
508  printf_filtered (_("No common block '%s'.\n"), comname);
509  else
510  printf_filtered (_("No common blocks.\n"));
511  }
512 }
513 
514 void
516 {
517  add_info ("common", info_common_command,
518  _("Print out the values contained in a Fortran COMMON block."));
519 }
void generic_val_print(struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int recurse, const struct value *original_value, const struct value_print_options *options, const struct generic_val_print_decorations *decorations)
Definition: valprint.c:374
#define F77_DIM_SIZE(n)
Definition: f-valprint.c:51
void val_print_scalar_formatted(struct type *type, const gdb_byte *valaddr, int embedded_offset, const struct value *val, const struct value_print_options *options, int size, struct ui_file *stream)
Definition: valprint.c:960
int f77_get_upperbound(struct type *type)
Definition: f-valprint.c:67
int demangle
Definition: demangle.c:49
struct frame_info * get_selected_frame(const char *message)
Definition: frame.c:1535
#define SYMBOL_PRINT_NAME(symbol)
Definition: symtab.h:260
void value_print(struct value *val, struct ui_file *stream, const struct value_print_options *options)
Definition: valprint.c:870
bfd_vma CORE_ADDR
Definition: common-types.h:41
#define F77_DIM_OFFSET(n)
Definition: f-valprint.c:55
CORE_ADDR unpack_pointer(struct type *type, const gdb_byte *valaddr)
Definition: value.c:2914
int calc_f77_array_dims(struct type *array_type)
Definition: eval.c:3119
struct ui_file * gdb_stdout
Definition: main.c:71
#define SYMBOL_CLASS(symbol)
Definition: symtab.h:793
void val_print_type_code_int(struct type *type, const gdb_byte *valaddr, struct ui_file *stream)
Definition: valprint.c:898
#define SYMBOL_VALUE_COMMON_BLOCK(symbol)
Definition: symtab.h:184
#define _(String)
Definition: gdb_locale.h:40
#define END_CATCH
#define TYPE_FIELD_TYPE(thistype, n)
Definition: gdbtypes.h:1368
size_t n_entries
Definition: f-lang.h:58
void printf_filtered(const char *format,...)
Definition: utils.c:2388
const char * paddress(struct gdbarch *gdbarch, CORE_ADDR addr)
Definition: utils.c:2743
static void f77_create_arrayprint_offset_tbl(struct type *, struct ui_file *)
Definition: f-valprint.c:118
#define BLOCK_FUNCTION(bl)
Definition: block.h:118
#define TRY
const char *const name
Definition: aarch64-tdep.c:68
struct type * check_typedef(struct type *type)
Definition: gdbtypes.c:2217
struct symbol * contents[1]
Definition: f-lang.h:62
#define CATCH(EXCEPTION, MASK)
#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype)
Definition: gdbtypes.h:1284
#define SYMBOL_DOMAIN(symbol)
Definition: symtab.h:790
void fprintf_filtered(struct ui_file *stream, const char *format,...)
Definition: utils.c:2351
const struct block * get_frame_block(struct frame_info *frame, CORE_ADDR *addr_in_block)
Definition: blockframe.c:55
void fputs_filtered(const char *linebuffer, struct ui_file *stream)
Definition: utils.c:2145
enum bfd_endian gdbarch_byte_order(struct gdbarch *gdbarch)
Definition: gdbarch.c:1420
Definition: gdbtypes.h:749
int f77_get_lowerbound(struct type *type)
Definition: f-valprint.c:58
#define BLOCK_SUPERBLOCK(bl)
Definition: block.h:119
struct gdbarch * get_type_arch(const struct type *type)
Definition: gdbtypes.c:232
struct cmd_list_element * add_info(const char *name, cmd_cfunc_ftype *fun, const char *doc)
Definition: cli-decode.c:857
static const char * type
Definition: language.c:103
#define gdb_assert(expr)
Definition: gdb_assert.h:33
#define SYMBOL_LINKAGE_NAME(symbol)
Definition: symtab.h:241
int f77_array_offset_tbl[MAX_FORTRAN_DIMS+1][2]
Definition: f-valprint.c:43
int putchar_filtered(int c)
Definition: utils.c:2163
#define MAX_FORTRAN_DIMS
Definition: language.h:40
#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype)
Definition: gdbtypes.h:1282
LONGEST unpack_long(struct type *type, const gdb_byte *valaddr)
Definition: value.c:2797
#define TYPE_FIELD_BITPOS(thistype, n)
Definition: gdbtypes.h:1371
Definition: block.h:60
static void f77_get_dynamic_length_of_aggregate(struct type *)
Definition: f-valprint.c:85
Definition: value.c:172
void _initialize_f_valprint(void)
Definition: f-valprint.c:515
bfd_byte gdb_byte
Definition: common-types.h:38
const struct language_defn * current_language
Definition: language.c:85
#define TYPE_TARGET_TYPE(thistype)
Definition: gdbtypes.h:1229
#define TYPE_CODE(thistype)
Definition: gdbtypes.h:1240
struct value * value_of_variable(struct symbol *var, const struct block *b)
Definition: valops.c:1291
void get_user_print_options(struct value_print_options *opts)
Definition: valprint.c:129
int offset
Definition: agent.c:65
#define TYPE_NFIELDS(thistype)
Definition: gdbtypes.h:1241
static void info_common_command(char *, int)
Definition: f-valprint.c:472
int print_address_demangle(const struct value_print_options *opts, struct gdbarch *gdbarch, CORE_ADDR addr, struct ui_file *stream, int do_demangle)
Definition: printcmd.c:771
#define CHECK_TYPEDEF(TYPE)
Definition: gdbtypes.h:1817
static void info_common_command_for_block(const struct block *block, const char *comname, int *any_printed)
Definition: f-valprint.c:411
#define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype)
Definition: gdbtypes.h:1290
unsigned int print_max
Definition: valprint.h:53
static void f77_print_array(struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int recurse, const struct value *val, const struct value_print_options *options)
Definition: f-valprint.c:211
Definition: symtab.h:703
#define LA_PRINT_STRING(stream, elttype, string, length, encoding, force_ellipses, options)
Definition: language.h:496
#define TYPE_LENGTH(thistype)
Definition: gdbtypes.h:1237
int val_print_string(struct type *elttype, const char *encoding, CORE_ADDR addr, int len, struct ui_file *stream, const struct value_print_options *options)
Definition: valprint.c:2496
#define LA_PRINT_CHAR(ch, type, stream)
Definition: language.h:494
void print_function_pointer_address(const struct value_print_options *options, struct gdbarch *gdbarch, CORE_ADDR address, struct ui_file *stream)
Definition: valprint.c:1571
void gdb_flush(struct ui_file *file)
Definition: ui-file.c:192
static void f77_print_array_1(int nss, int ndimensions, struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int recurse, const struct value *val, const struct value_print_options *options, int *elts)
Definition: f-valprint.c:159
enum bfd_endian byte_order
Definition: gdbarch.c:128
#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype)
Definition: gdbtypes.h:1287
void f_val_print(struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int recurse, const struct value *original_value, const struct value_print_options *options)
Definition: f-valprint.c:255
void val_print(struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int recurse, const struct value *val, const struct value_print_options *options, const struct language_defn *language)
Definition: valprint.c:737
void error(const char *fmt,...)
Definition: errors.c:38
#define ALL_BLOCK_SYMBOLS(block, iter, sym)
Definition: block.h:333
long long LONGEST
Definition: common-types.h:52