HAMMER 61F/Many: Stabilization w/ simultanious pruning and reblocking
[dragonfly.git] / contrib / gdb-6 / gdb / f-valprint.c
blobf3d006777de7343708709d7f1adf7e641d81a70a
1 /* Support for printing Fortran values for GDB, the GNU debugger.
3 Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005, 2006,
4 2007 Free Software Foundation, Inc.
6 Contributed by Motorola. Adapted from the C definitions by Farooq Butt
7 (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
9 This file is part of GDB.
11 This program is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation; either version 3 of the License, or
14 (at your option) any later version.
16 This program is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24 #include "defs.h"
25 #include "gdb_string.h"
26 #include "symtab.h"
27 #include "gdbtypes.h"
28 #include "expression.h"
29 #include "value.h"
30 #include "valprint.h"
31 #include "language.h"
32 #include "f-lang.h"
33 #include "frame.h"
34 #include "gdbcore.h"
35 #include "command.h"
36 #include "block.h"
38 #if 0
39 static int there_is_a_visible_common_named (char *);
40 #endif
42 extern void _initialize_f_valprint (void);
43 static void info_common_command (char *, int);
44 static void list_all_visible_commons (char *);
45 static void f77_create_arrayprint_offset_tbl (struct type *,
46 struct ui_file *);
47 static void f77_get_dynamic_length_of_aggregate (struct type *);
49 int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
51 /* Array which holds offsets to be applied to get a row's elements
52 for a given array. Array also holds the size of each subarray. */
54 /* The following macro gives us the size of the nth dimension, Where
55 n is 1 based. */
57 #define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
59 /* The following gives us the offset for row n where n is 1-based. */
61 #define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
63 int
64 f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
66 struct frame_info *frame;
67 CORE_ADDR current_frame_addr;
68 CORE_ADDR ptr_to_lower_bound;
70 switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
72 case BOUND_BY_VALUE_ON_STACK:
73 frame = deprecated_safe_get_selected_frame ();
74 current_frame_addr = get_frame_base (frame);
75 if (current_frame_addr > 0)
77 *lower_bound =
78 read_memory_integer (current_frame_addr +
79 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
80 4);
82 else
84 *lower_bound = DEFAULT_LOWER_BOUND;
85 return BOUND_FETCH_ERROR;
87 break;
89 case BOUND_SIMPLE:
90 *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
91 break;
93 case BOUND_CANNOT_BE_DETERMINED:
94 error (_("Lower bound may not be '*' in F77"));
95 break;
97 case BOUND_BY_REF_ON_STACK:
98 frame = deprecated_safe_get_selected_frame ();
99 current_frame_addr = get_frame_base (frame);
100 if (current_frame_addr > 0)
102 ptr_to_lower_bound =
103 read_memory_typed_address (current_frame_addr +
104 TYPE_ARRAY_LOWER_BOUND_VALUE (type),
105 builtin_type_void_data_ptr);
106 *lower_bound = read_memory_integer (ptr_to_lower_bound, 4);
108 else
110 *lower_bound = DEFAULT_LOWER_BOUND;
111 return BOUND_FETCH_ERROR;
113 break;
115 case BOUND_BY_REF_IN_REG:
116 case BOUND_BY_VALUE_IN_REG:
117 default:
118 error (_("??? unhandled dynamic array bound type ???"));
119 break;
121 return BOUND_FETCH_OK;
125 f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
127 struct frame_info *frame;
128 CORE_ADDR current_frame_addr = 0;
129 CORE_ADDR ptr_to_upper_bound;
131 switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
133 case BOUND_BY_VALUE_ON_STACK:
134 frame = deprecated_safe_get_selected_frame ();
135 current_frame_addr = get_frame_base (frame);
136 if (current_frame_addr > 0)
138 *upper_bound =
139 read_memory_integer (current_frame_addr +
140 TYPE_ARRAY_UPPER_BOUND_VALUE (type),
143 else
145 *upper_bound = DEFAULT_UPPER_BOUND;
146 return BOUND_FETCH_ERROR;
148 break;
150 case BOUND_SIMPLE:
151 *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
152 break;
154 case BOUND_CANNOT_BE_DETERMINED:
155 /* we have an assumed size array on our hands. Assume that
156 upper_bound == lower_bound so that we show at least
157 1 element.If the user wants to see more elements, let
158 him manually ask for 'em and we'll subscript the
159 array and show him */
160 f77_get_dynamic_lowerbound (type, upper_bound);
161 break;
163 case BOUND_BY_REF_ON_STACK:
164 frame = deprecated_safe_get_selected_frame ();
165 current_frame_addr = get_frame_base (frame);
166 if (current_frame_addr > 0)
168 ptr_to_upper_bound =
169 read_memory_typed_address (current_frame_addr +
170 TYPE_ARRAY_UPPER_BOUND_VALUE (type),
171 builtin_type_void_data_ptr);
172 *upper_bound = read_memory_integer (ptr_to_upper_bound, 4);
174 else
176 *upper_bound = DEFAULT_UPPER_BOUND;
177 return BOUND_FETCH_ERROR;
179 break;
181 case BOUND_BY_REF_IN_REG:
182 case BOUND_BY_VALUE_IN_REG:
183 default:
184 error (_("??? unhandled dynamic array bound type ???"));
185 break;
187 return BOUND_FETCH_OK;
190 /* Obtain F77 adjustable array dimensions */
192 static void
193 f77_get_dynamic_length_of_aggregate (struct type *type)
195 int upper_bound = -1;
196 int lower_bound = 1;
197 int retcode;
199 /* Recursively go all the way down into a possibly multi-dimensional
200 F77 array and get the bounds. For simple arrays, this is pretty
201 easy but when the bounds are dynamic, we must be very careful
202 to add up all the lengths correctly. Not doing this right
203 will lead to horrendous-looking arrays in parameter lists.
205 This function also works for strings which behave very
206 similarly to arrays. */
208 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY
209 || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
210 f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type));
212 /* Recursion ends here, start setting up lengths. */
213 retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
214 if (retcode == BOUND_FETCH_ERROR)
215 error (_("Cannot obtain valid array lower bound"));
217 retcode = f77_get_dynamic_upperbound (type, &upper_bound);
218 if (retcode == BOUND_FETCH_ERROR)
219 error (_("Cannot obtain valid array upper bound"));
221 /* Patch in a valid length value. */
223 TYPE_LENGTH (type) =
224 (upper_bound - lower_bound + 1) * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
227 /* Function that sets up the array offset,size table for the array
228 type "type". */
230 static void
231 f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
233 struct type *tmp_type;
234 int eltlen;
235 int ndimen = 1;
236 int upper, lower, retcode;
238 tmp_type = type;
240 while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY))
242 if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED)
243 fprintf_filtered (stream, "<assumed size array> ");
245 retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
246 if (retcode == BOUND_FETCH_ERROR)
247 error (_("Cannot obtain dynamic upper bound"));
249 retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
250 if (retcode == BOUND_FETCH_ERROR)
251 error (_("Cannot obtain dynamic lower bound"));
253 F77_DIM_SIZE (ndimen) = upper - lower + 1;
255 tmp_type = TYPE_TARGET_TYPE (tmp_type);
256 ndimen++;
259 /* Now we multiply eltlen by all the offsets, so that later we
260 can print out array elements correctly. Up till now we
261 know an offset to apply to get the item but we also
262 have to know how much to add to get to the next item */
264 ndimen--;
265 eltlen = TYPE_LENGTH (tmp_type);
266 F77_DIM_OFFSET (ndimen) = eltlen;
267 while (--ndimen > 0)
269 eltlen *= F77_DIM_SIZE (ndimen + 1);
270 F77_DIM_OFFSET (ndimen) = eltlen;
276 /* Actual function which prints out F77 arrays, Valaddr == address in
277 the superior. Address == the address in the inferior. */
279 static void
280 f77_print_array_1 (int nss, int ndimensions, struct type *type,
281 const gdb_byte *valaddr, CORE_ADDR address,
282 struct ui_file *stream, int format,
283 int deref_ref, int recurse, enum val_prettyprint pretty,
284 int *elts)
286 int i;
288 if (nss != ndimensions)
290 for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++)
292 fprintf_filtered (stream, "( ");
293 f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
294 valaddr + i * F77_DIM_OFFSET (nss),
295 address + i * F77_DIM_OFFSET (nss),
296 stream, format, deref_ref, recurse, pretty, elts);
297 fprintf_filtered (stream, ") ");
299 if (*elts >= print_max && i < F77_DIM_SIZE (nss))
300 fprintf_filtered (stream, "...");
302 else
304 for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max;
305 i++, (*elts)++)
307 val_print (TYPE_TARGET_TYPE (type),
308 valaddr + i * F77_DIM_OFFSET (ndimensions),
310 address + i * F77_DIM_OFFSET (ndimensions),
311 stream, format, deref_ref, recurse, pretty);
313 if (i != (F77_DIM_SIZE (nss) - 1))
314 fprintf_filtered (stream, ", ");
316 if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1)))
317 fprintf_filtered (stream, "...");
322 /* This function gets called to print an F77 array, we set up some
323 stuff and then immediately call f77_print_array_1() */
325 static void
326 f77_print_array (struct type *type, const gdb_byte *valaddr,
327 CORE_ADDR address, struct ui_file *stream,
328 int format, int deref_ref, int recurse,
329 enum val_prettyprint pretty)
331 int ndimensions;
332 int elts = 0;
334 ndimensions = calc_f77_array_dims (type);
336 if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0)
337 error (_("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
338 ndimensions, MAX_FORTRAN_DIMS);
340 /* Since F77 arrays are stored column-major, we set up an
341 offset table to get at the various row's elements. The
342 offset table contains entries for both offset and subarray size. */
344 f77_create_arrayprint_offset_tbl (type, stream);
346 f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
347 deref_ref, recurse, pretty, &elts);
351 /* Print data of type TYPE located at VALADDR (within GDB), which came from
352 the inferior at address ADDRESS, onto stdio stream STREAM according to
353 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
354 target byte order.
356 If the data are a string pointer, returns the number of string characters
357 printed.
359 If DEREF_REF is nonzero, then dereference references, otherwise just print
360 them like pointers.
362 The PRETTY parameter controls prettyprinting. */
365 f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
366 CORE_ADDR address, struct ui_file *stream, int format,
367 int deref_ref, int recurse, enum val_prettyprint pretty)
369 unsigned int i = 0; /* Number of characters printed */
370 struct type *elttype;
371 LONGEST val;
372 CORE_ADDR addr;
373 int index;
375 CHECK_TYPEDEF (type);
376 switch (TYPE_CODE (type))
378 case TYPE_CODE_STRING:
379 f77_get_dynamic_length_of_aggregate (type);
380 LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
381 break;
383 case TYPE_CODE_ARRAY:
384 fprintf_filtered (stream, "(");
385 f77_print_array (type, valaddr, address, stream, format,
386 deref_ref, recurse, pretty);
387 fprintf_filtered (stream, ")");
388 break;
390 case TYPE_CODE_PTR:
391 if (format && format != 's')
393 print_scalar_formatted (valaddr, type, format, 0, stream);
394 break;
396 else
398 addr = unpack_pointer (type, valaddr);
399 elttype = check_typedef (TYPE_TARGET_TYPE (type));
401 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
403 /* Try to print what function it points to. */
404 print_address_demangle (addr, stream, demangle);
405 /* Return value is irrelevant except for string pointers. */
406 return 0;
409 if (addressprint && format != 's')
410 deprecated_print_address_numeric (addr, 1, stream);
412 /* For a pointer to char or unsigned char, also print the string
413 pointed to, unless pointer is null. */
414 if (TYPE_LENGTH (elttype) == 1
415 && TYPE_CODE (elttype) == TYPE_CODE_INT
416 && (format == 0 || format == 's')
417 && addr != 0)
418 i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
420 /* Return number of characters printed, including the terminating
421 '\0' if we reached the end. val_print_string takes care including
422 the terminating '\0' if necessary. */
423 return i;
425 break;
427 case TYPE_CODE_REF:
428 elttype = check_typedef (TYPE_TARGET_TYPE (type));
429 if (addressprint)
431 CORE_ADDR addr
432 = extract_typed_address (valaddr + embedded_offset, type);
433 fprintf_filtered (stream, "@");
434 deprecated_print_address_numeric (addr, 1, stream);
435 if (deref_ref)
436 fputs_filtered (": ", stream);
438 /* De-reference the reference. */
439 if (deref_ref)
441 if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
443 struct value *deref_val =
444 value_at
445 (TYPE_TARGET_TYPE (type),
446 unpack_pointer (lookup_pointer_type (builtin_type_void),
447 valaddr + embedded_offset));
448 common_val_print (deref_val, stream, format, deref_ref, recurse,
449 pretty);
451 else
452 fputs_filtered ("???", stream);
454 break;
456 case TYPE_CODE_FUNC:
457 if (format)
459 print_scalar_formatted (valaddr, type, format, 0, stream);
460 break;
462 /* FIXME, we should consider, at least for ANSI C language, eliminating
463 the distinction made between FUNCs and POINTERs to FUNCs. */
464 fprintf_filtered (stream, "{");
465 type_print (type, "", stream, -1);
466 fprintf_filtered (stream, "} ");
467 /* Try to print what function it points to, and its address. */
468 print_address_demangle (address, stream, demangle);
469 break;
471 case TYPE_CODE_INT:
472 format = format ? format : output_format;
473 if (format)
474 print_scalar_formatted (valaddr, type, format, 0, stream);
475 else
477 val_print_type_code_int (type, valaddr, stream);
478 /* C and C++ has no single byte int type, char is used instead.
479 Since we don't know whether the value is really intended to
480 be used as an integer or a character, print the character
481 equivalent as well. */
482 if (TYPE_LENGTH (type) == 1)
484 fputs_filtered (" ", stream);
485 LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
486 stream);
489 break;
491 case TYPE_CODE_FLAGS:
492 if (format)
493 print_scalar_formatted (valaddr, type, format, 0, stream);
494 else
495 val_print_type_code_flags (type, valaddr, stream);
496 break;
498 case TYPE_CODE_FLT:
499 if (format)
500 print_scalar_formatted (valaddr, type, format, 0, stream);
501 else
502 print_floating (valaddr, type, stream);
503 break;
505 case TYPE_CODE_VOID:
506 fprintf_filtered (stream, "VOID");
507 break;
509 case TYPE_CODE_ERROR:
510 fprintf_filtered (stream, "<error type>");
511 break;
513 case TYPE_CODE_RANGE:
514 /* FIXME, we should not ever have to print one of these yet. */
515 fprintf_filtered (stream, "<range type>");
516 break;
518 case TYPE_CODE_BOOL:
519 format = format ? format : output_format;
520 if (format)
521 print_scalar_formatted (valaddr, type, format, 0, stream);
522 else
524 val = 0;
525 switch (TYPE_LENGTH (type))
527 case 1:
528 val = unpack_long (builtin_type_f_logical_s1, valaddr);
529 break;
531 case 2:
532 val = unpack_long (builtin_type_f_logical_s2, valaddr);
533 break;
535 case 4:
536 val = unpack_long (builtin_type_f_logical, valaddr);
537 break;
539 default:
540 error (_("Logicals of length %d bytes not supported"),
541 TYPE_LENGTH (type));
545 if (val == 0)
546 fprintf_filtered (stream, ".FALSE.");
547 else if (val == 1)
548 fprintf_filtered (stream, ".TRUE.");
549 else
550 /* Not a legitimate logical type, print as an integer. */
552 /* Bash the type code temporarily. */
553 TYPE_CODE (type) = TYPE_CODE_INT;
554 f_val_print (type, valaddr, 0, address, stream, format,
555 deref_ref, recurse, pretty);
556 /* Restore the type code so later uses work as intended. */
557 TYPE_CODE (type) = TYPE_CODE_BOOL;
560 break;
562 case TYPE_CODE_COMPLEX:
563 switch (TYPE_LENGTH (type))
565 case 8:
566 type = builtin_type_f_real;
567 break;
568 case 16:
569 type = builtin_type_f_real_s8;
570 break;
571 case 32:
572 type = builtin_type_f_real_s16;
573 break;
574 default:
575 error (_("Cannot print out complex*%d variables"), TYPE_LENGTH (type));
577 fputs_filtered ("(", stream);
578 print_floating (valaddr, type, stream);
579 fputs_filtered (",", stream);
580 print_floating (valaddr + TYPE_LENGTH (type), type, stream);
581 fputs_filtered (")", stream);
582 break;
584 case TYPE_CODE_UNDEF:
585 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
586 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
587 and no complete type for struct foo in that file. */
588 fprintf_filtered (stream, "<incomplete type>");
589 break;
591 case TYPE_CODE_STRUCT:
592 /* Starting from the Fortran 90 standard, Fortran supports derived
593 types. */
594 fprintf_filtered (stream, "{ ");
595 for (index = 0; index < TYPE_NFIELDS (type); index++)
597 int offset = TYPE_FIELD_BITPOS (type, index) / 8;
598 f_val_print (TYPE_FIELD_TYPE (type, index), valaddr + offset,
599 embedded_offset, address, stream,
600 format, deref_ref, recurse, pretty);
601 if (index != TYPE_NFIELDS (type) - 1)
602 fputs_filtered (", ", stream);
604 fprintf_filtered (stream, "}");
605 break;
607 default:
608 error (_("Invalid F77 type code %d in symbol table."), TYPE_CODE (type));
610 gdb_flush (stream);
611 return 0;
614 static void
615 list_all_visible_commons (char *funname)
617 SAVED_F77_COMMON_PTR tmp;
619 tmp = head_common_list;
621 printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
623 while (tmp != NULL)
625 if (strcmp (tmp->owning_function, funname) == 0)
626 printf_filtered ("%s\n", tmp->name);
628 tmp = tmp->next;
632 /* This function is used to print out the values in a given COMMON
633 block. It will always use the most local common block of the
634 given name */
636 static void
637 info_common_command (char *comname, int from_tty)
639 SAVED_F77_COMMON_PTR the_common;
640 COMMON_ENTRY_PTR entry;
641 struct frame_info *fi;
642 char *funname = 0;
643 struct symbol *func;
645 /* We have been told to display the contents of F77 COMMON
646 block supposedly visible in this function. Let us
647 first make sure that it is visible and if so, let
648 us display its contents */
650 fi = get_selected_frame (_("No frame selected"));
652 /* The following is generally ripped off from stack.c's routine
653 print_frame_info() */
655 func = find_pc_function (get_frame_pc (fi));
656 if (func)
658 /* In certain pathological cases, the symtabs give the wrong
659 function (when we are in the first function in a file which
660 is compiled without debugging symbols, the previous function
661 is compiled with debugging symbols, and the "foo.o" symbol
662 that is supposed to tell us where the file with debugging symbols
663 ends has been truncated by ar because it is longer than 15
664 characters).
666 So look in the minimal symbol tables as well, and if it comes
667 up with a larger address for the function use that instead.
668 I don't think this can ever cause any problems; there shouldn't
669 be any minimal symbols in the middle of a function.
670 FIXME: (Not necessarily true. What about text labels) */
672 struct minimal_symbol *msymbol =
673 lookup_minimal_symbol_by_pc (get_frame_pc (fi));
675 if (msymbol != NULL
676 && (SYMBOL_VALUE_ADDRESS (msymbol)
677 > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
678 funname = DEPRECATED_SYMBOL_NAME (msymbol);
679 else
680 funname = DEPRECATED_SYMBOL_NAME (func);
682 else
684 struct minimal_symbol *msymbol =
685 lookup_minimal_symbol_by_pc (get_frame_pc (fi));
687 if (msymbol != NULL)
688 funname = DEPRECATED_SYMBOL_NAME (msymbol);
689 else /* Got no 'funname', code below will fail. */
690 error (_("No function found for frame."));
693 /* If comname is NULL, we assume the user wishes to see the
694 which COMMON blocks are visible here and then return */
696 if (comname == 0)
698 list_all_visible_commons (funname);
699 return;
702 the_common = find_common_for_function (comname, funname);
704 if (the_common)
706 if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
707 printf_filtered (_("Contents of blank COMMON block:\n"));
708 else
709 printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
711 printf_filtered ("\n");
712 entry = the_common->entries;
714 while (entry != NULL)
716 printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
717 print_variable_value (entry->symbol, fi, gdb_stdout);
718 printf_filtered ("\n");
719 entry = entry->next;
722 else
723 printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
724 comname, funname);
727 /* This function is used to determine whether there is a
728 F77 common block visible at the current scope called 'comname'. */
730 #if 0
731 static int
732 there_is_a_visible_common_named (char *comname)
734 SAVED_F77_COMMON_PTR the_common;
735 struct frame_info *fi;
736 char *funname = 0;
737 struct symbol *func;
739 if (comname == NULL)
740 error (_("Cannot deal with NULL common name!"));
742 fi = get_selected_frame (_("No frame selected"));
744 /* The following is generally ripped off from stack.c's routine
745 print_frame_info() */
747 func = find_pc_function (fi->pc);
748 if (func)
750 /* In certain pathological cases, the symtabs give the wrong
751 function (when we are in the first function in a file which
752 is compiled without debugging symbols, the previous function
753 is compiled with debugging symbols, and the "foo.o" symbol
754 that is supposed to tell us where the file with debugging symbols
755 ends has been truncated by ar because it is longer than 15
756 characters).
758 So look in the minimal symbol tables as well, and if it comes
759 up with a larger address for the function use that instead.
760 I don't think this can ever cause any problems; there shouldn't
761 be any minimal symbols in the middle of a function.
762 FIXME: (Not necessarily true. What about text labels) */
764 struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
766 if (msymbol != NULL
767 && (SYMBOL_VALUE_ADDRESS (msymbol)
768 > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
769 funname = DEPRECATED_SYMBOL_NAME (msymbol);
770 else
771 funname = DEPRECATED_SYMBOL_NAME (func);
773 else
775 struct minimal_symbol *msymbol =
776 lookup_minimal_symbol_by_pc (fi->pc);
778 if (msymbol != NULL)
779 funname = DEPRECATED_SYMBOL_NAME (msymbol);
782 the_common = find_common_for_function (comname, funname);
784 return (the_common ? 1 : 0);
786 #endif
788 void
789 _initialize_f_valprint (void)
791 add_info ("common", info_common_command,
792 _("Print out the values contained in a Fortran COMMON block."));
793 if (xdb_commands)
794 add_com ("lc", class_info, info_common_command,
795 _("Print out the values contained in a Fortran COMMON block."));