1/* Support for printing Fortran values for GDB, the GNU debugger. 2 Copyright 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003 3 Free Software Foundation, Inc. 4 Contributed by Motorola. Adapted from the C definitions by Farooq Butt 5 (fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs. 6 7 This file is part of GDB. 8 9 This program is free software; you can redistribute it and/or modify 10 it under the terms of the GNU General Public License as published by 11 the Free Software Foundation; either version 2 of the License, or 12 (at your option) any later version. 13 14 This program is distributed in the hope that it will be useful, 15 but WITHOUT ANY WARRANTY; without even the implied warranty of 16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 GNU General Public License for more details. 18 19 You should have received a copy of the GNU General Public License 20 along with this program; if not, write to the Free Software 21 Foundation, Inc., 59 Temple Place - Suite 330, 22 Boston, MA 02111-1307, USA. */ 23 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" 37 38#if 0 39static int there_is_a_visible_common_named (char *); 40#endif 41 42extern void _initialize_f_valprint (void); 43static void info_common_command (char *, int); 44static void list_all_visible_commons (char *); 45static void f77_print_array (struct type *, char *, CORE_ADDR, 46 struct ui_file *, int, int, int, 47 enum val_prettyprint); 48static void f77_print_array_1 (int, int, struct type *, char *, 49 CORE_ADDR, struct ui_file *, int, int, int, 50 enum val_prettyprint, 51 int *elts); 52static void f77_create_arrayprint_offset_tbl (struct type *, 53 struct ui_file *); 54static void f77_get_dynamic_length_of_aggregate (struct type *); 55 56int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2]; 57 58/* Array which holds offsets to be applied to get a row's elements 59 for a given array. Array also holds the size of each subarray. */ 60 61/* The following macro gives us the size of the nth dimension, Where 62 n is 1 based. */ 63 64#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1]) 65 66/* The following gives us the offset for row n where n is 1-based. */ 67 68#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0]) 69 70int 71f77_get_dynamic_lowerbound (struct type *type, int *lower_bound) 72{ 73 CORE_ADDR current_frame_addr; 74 CORE_ADDR ptr_to_lower_bound; 75 76 switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type)) 77 { 78 case BOUND_BY_VALUE_ON_STACK: 79 current_frame_addr = get_frame_base (deprecated_selected_frame); 80 if (current_frame_addr > 0) 81 { 82 *lower_bound = 83 read_memory_integer (current_frame_addr + 84 TYPE_ARRAY_LOWER_BOUND_VALUE (type), 85 4); 86 } 87 else 88 { 89 *lower_bound = DEFAULT_LOWER_BOUND; 90 return BOUND_FETCH_ERROR; 91 } 92 break; 93 94 case BOUND_SIMPLE: 95 *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type); 96 break; 97 98 case BOUND_CANNOT_BE_DETERMINED: 99 error ("Lower bound may not be '*' in F77"); 100 break; 101 102 case BOUND_BY_REF_ON_STACK: 103 current_frame_addr = get_frame_base (deprecated_selected_frame); 104 if (current_frame_addr > 0) 105 { 106 ptr_to_lower_bound = 107 read_memory_typed_address (current_frame_addr + 108 TYPE_ARRAY_LOWER_BOUND_VALUE (type), 109 builtin_type_void_data_ptr); 110 *lower_bound = read_memory_integer (ptr_to_lower_bound, 4); 111 } 112 else 113 { 114 *lower_bound = DEFAULT_LOWER_BOUND; 115 return BOUND_FETCH_ERROR; 116 } 117 break; 118 119 case BOUND_BY_REF_IN_REG: 120 case BOUND_BY_VALUE_IN_REG: 121 default: 122 error ("??? unhandled dynamic array bound type ???"); 123 break; 124 } 125 return BOUND_FETCH_OK; 126} 127 128int 129f77_get_dynamic_upperbound (struct type *type, int *upper_bound) 130{ 131 CORE_ADDR current_frame_addr = 0; 132 CORE_ADDR ptr_to_upper_bound; 133 134 switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type)) 135 { 136 case BOUND_BY_VALUE_ON_STACK: 137 current_frame_addr = get_frame_base (deprecated_selected_frame); 138 if (current_frame_addr > 0) 139 { 140 *upper_bound = 141 read_memory_integer (current_frame_addr + 142 TYPE_ARRAY_UPPER_BOUND_VALUE (type), 143 4); 144 } 145 else 146 { 147 *upper_bound = DEFAULT_UPPER_BOUND; 148 return BOUND_FETCH_ERROR; 149 } 150 break; 151 152 case BOUND_SIMPLE: 153 *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type); 154 break; 155 156 case BOUND_CANNOT_BE_DETERMINED: 157 /* we have an assumed size array on our hands. Assume that 158 upper_bound == lower_bound so that we show at least 159 1 element.If the user wants to see more elements, let 160 him manually ask for 'em and we'll subscript the 161 array and show him */ 162 f77_get_dynamic_lowerbound (type, upper_bound); 163 break; 164 165 case BOUND_BY_REF_ON_STACK: 166 current_frame_addr = get_frame_base (deprecated_selected_frame); 167 if (current_frame_addr > 0) 168 { 169 ptr_to_upper_bound = 170 read_memory_typed_address (current_frame_addr + 171 TYPE_ARRAY_UPPER_BOUND_VALUE (type), 172 builtin_type_void_data_ptr); 173 *upper_bound = read_memory_integer (ptr_to_upper_bound, 4); 174 } 175 else 176 { 177 *upper_bound = DEFAULT_UPPER_BOUND; 178 return BOUND_FETCH_ERROR; 179 } 180 break; 181 182 case BOUND_BY_REF_IN_REG: 183 case BOUND_BY_VALUE_IN_REG: 184 default: 185 error ("??? unhandled dynamic array bound type ???"); 186 break; 187 } 188 return BOUND_FETCH_OK; 189} 190 191/* Obtain F77 adjustable array dimensions */ 192 193static void 194f77_get_dynamic_length_of_aggregate (struct type *type) 195{ 196 int upper_bound = -1; 197 int lower_bound = 1; 198 int retcode; 199 200 /* Recursively go all the way down into a possibly multi-dimensional 201 F77 array and get the bounds. For simple arrays, this is pretty 202 easy but when the bounds are dynamic, we must be very careful 203 to add up all the lengths correctly. Not doing this right 204 will lead to horrendous-looking arrays in parameter lists. 205 206 This function also works for strings which behave very 207 similarly to arrays. */ 208 209 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY 210 || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING) 211 f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type)); 212 213 /* Recursion ends here, start setting up lengths. */ 214 retcode = f77_get_dynamic_lowerbound (type, &lower_bound); 215 if (retcode == BOUND_FETCH_ERROR) 216 error ("Cannot obtain valid array lower bound"); 217 218 retcode = f77_get_dynamic_upperbound (type, &upper_bound); 219 if (retcode == BOUND_FETCH_ERROR) 220 error ("Cannot obtain valid array upper bound"); 221 222 /* Patch in a valid length value. */ 223 224 TYPE_LENGTH (type) = 225 (upper_bound - lower_bound + 1) * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type))); 226} 227 228/* Function that sets up the array offset,size table for the array 229 type "type". */ 230 231static void 232f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream) 233{ 234 struct type *tmp_type; 235 int eltlen; 236 int ndimen = 1; 237 int upper, lower, retcode; 238 239 tmp_type = type; 240 241 while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)) 242 { 243 if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED) 244 fprintf_filtered (stream, "<assumed size array> "); 245 246 retcode = f77_get_dynamic_upperbound (tmp_type, &upper); 247 if (retcode == BOUND_FETCH_ERROR) 248 error ("Cannot obtain dynamic upper bound"); 249 250 retcode = f77_get_dynamic_lowerbound (tmp_type, &lower); 251 if (retcode == BOUND_FETCH_ERROR) 252 error ("Cannot obtain dynamic lower bound"); 253 254 F77_DIM_SIZE (ndimen) = upper - lower + 1; 255 256 tmp_type = TYPE_TARGET_TYPE (tmp_type); 257 ndimen++; 258 } 259 260 /* Now we multiply eltlen by all the offsets, so that later we 261 can print out array elements correctly. Up till now we 262 know an offset to apply to get the item but we also 263 have to know how much to add to get to the next item */ 264 265 ndimen--; 266 eltlen = TYPE_LENGTH (tmp_type); 267 F77_DIM_OFFSET (ndimen) = eltlen; 268 while (--ndimen > 0) 269 { 270 eltlen *= F77_DIM_SIZE (ndimen + 1); 271 F77_DIM_OFFSET (ndimen) = eltlen; 272 } 273} 274 275 276 277/* Actual function which prints out F77 arrays, Valaddr == address in 278 the superior. Address == the address in the inferior. */ 279 280static void 281f77_print_array_1 (int nss, int ndimensions, struct type *type, char *valaddr, 282 CORE_ADDR address, struct ui_file *stream, int format, 283 int deref_ref, int recurse, enum val_prettyprint pretty, 284 int *elts) 285{ 286 int i; 287 288 if (nss != ndimensions) 289 { 290 for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++) 291 { 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, ") "); 298 } 299 if (*elts >= print_max && i < F77_DIM_SIZE (nss)) 300 fprintf_filtered (stream, "..."); 301 } 302 else 303 { 304 for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max; 305 i++, (*elts)++) 306 { 307 val_print (TYPE_TARGET_TYPE (type), 308 valaddr + i * F77_DIM_OFFSET (ndimensions), 309 0, 310 address + i * F77_DIM_OFFSET (ndimensions), 311 stream, format, deref_ref, recurse, pretty); 312 313 if (i != (F77_DIM_SIZE (nss) - 1)) 314 fprintf_filtered (stream, ", "); 315 316 if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1))) 317 fprintf_filtered (stream, "..."); 318 } 319 } 320} 321 322/* This function gets called to print an F77 array, we set up some 323 stuff and then immediately call f77_print_array_1() */ 324 325static void 326f77_print_array (struct type *type, char *valaddr, CORE_ADDR address, 327 struct ui_file *stream, int format, int deref_ref, int recurse, 328 enum val_prettyprint pretty) 329{ 330 int ndimensions; 331 int elts = 0; 332 333 ndimensions = calc_f77_array_dims (type); 334 335 if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0) 336 error ("Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)", 337 ndimensions, MAX_FORTRAN_DIMS); 338 339 /* Since F77 arrays are stored column-major, we set up an 340 offset table to get at the various row's elements. The 341 offset table contains entries for both offset and subarray size. */ 342 343 f77_create_arrayprint_offset_tbl (type, stream); 344 345 f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format, 346 deref_ref, recurse, pretty, &elts); 347} 348 349 350/* Print data of type TYPE located at VALADDR (within GDB), which came from 351 the inferior at address ADDRESS, onto stdio stream STREAM according to 352 FORMAT (a letter or 0 for natural format). The data at VALADDR is in 353 target byte order. 354 355 If the data are a string pointer, returns the number of string characters 356 printed. 357 358 If DEREF_REF is nonzero, then dereference references, otherwise just print 359 them like pointers. 360 361 The PRETTY parameter controls prettyprinting. */ 362 363int 364f_val_print (struct type *type, char *valaddr, int embedded_offset, 365 CORE_ADDR address, struct ui_file *stream, int format, 366 int deref_ref, int recurse, enum val_prettyprint pretty) 367{ 368 unsigned int i = 0; /* Number of characters printed */ 369 struct type *elttype; 370 LONGEST val; 371 CORE_ADDR addr; 372 373 CHECK_TYPEDEF (type); 374 switch (TYPE_CODE (type)) 375 { 376 case TYPE_CODE_STRING: 377 f77_get_dynamic_length_of_aggregate (type); 378 LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0); 379 break; 380 381 case TYPE_CODE_ARRAY: 382 fprintf_filtered (stream, "("); 383 f77_print_array (type, valaddr, address, stream, format, 384 deref_ref, recurse, pretty); 385 fprintf_filtered (stream, ")"); 386 break; 387 388 case TYPE_CODE_PTR: 389 if (format && format != 's') 390 { 391 print_scalar_formatted (valaddr, type, format, 0, stream); 392 break; 393 } 394 else 395 { 396 addr = unpack_pointer (type, valaddr); 397 elttype = check_typedef (TYPE_TARGET_TYPE (type)); 398 399 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC) 400 { 401 /* Try to print what function it points to. */ 402 print_address_demangle (addr, stream, demangle); 403 /* Return value is irrelevant except for string pointers. */ 404 return 0; 405 } 406 407 if (addressprint && format != 's') 408 print_address_numeric (addr, 1, stream); 409 410 /* For a pointer to char or unsigned char, also print the string 411 pointed to, unless pointer is null. */ 412 if (TYPE_LENGTH (elttype) == 1 413 && TYPE_CODE (elttype) == TYPE_CODE_INT 414 && (format == 0 || format == 's') 415 && addr != 0) 416 i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream); 417 418 /* Return number of characters printed, including the terminating 419 '\0' if we reached the end. val_print_string takes care including 420 the terminating '\0' if necessary. */ 421 return i; 422 } 423 break; 424 425 case TYPE_CODE_REF: 426 elttype = check_typedef (TYPE_TARGET_TYPE (type)); 427 if (addressprint) 428 { 429 CORE_ADDR addr 430 = extract_typed_address (valaddr + embedded_offset, type); 431 fprintf_filtered (stream, "@"); 432 print_address_numeric (addr, 1, stream); 433 if (deref_ref) 434 fputs_filtered (": ", stream); 435 } 436 /* De-reference the reference. */ 437 if (deref_ref) 438 { 439 if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF) 440 { 441 struct value *deref_val = 442 value_at 443 (TYPE_TARGET_TYPE (type), 444 unpack_pointer (lookup_pointer_type (builtin_type_void), 445 valaddr + embedded_offset), 446 NULL); 447 common_val_print (deref_val, stream, format, deref_ref, recurse, 448 pretty); 449 } 450 else 451 fputs_filtered ("???", stream); 452 } 453 break; 454 455 case TYPE_CODE_FUNC: 456 if (format) 457 { 458 print_scalar_formatted (valaddr, type, format, 0, stream); 459 break; 460 } 461 /* FIXME, we should consider, at least for ANSI C language, eliminating 462 the distinction made between FUNCs and POINTERs to FUNCs. */ 463 fprintf_filtered (stream, "{"); 464 type_print (type, "", stream, -1); 465 fprintf_filtered (stream, "} "); 466 /* Try to print what function it points to, and its address. */ 467 print_address_demangle (address, stream, demangle); 468 break; 469 470 case TYPE_CODE_INT: 471 format = format ? format : output_format; 472 if (format) 473 print_scalar_formatted (valaddr, type, format, 0, stream); 474 else 475 { 476 val_print_type_code_int (type, valaddr, stream); 477 /* C and C++ has no single byte int type, char is used instead. 478 Since we don't know whether the value is really intended to 479 be used as an integer or a character, print the character 480 equivalent as well. */ 481 if (TYPE_LENGTH (type) == 1) 482 { 483 fputs_filtered (" ", stream); 484 LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr), 485 stream); 486 } 487 } 488 break; 489 490 case TYPE_CODE_FLT: 491 if (format) 492 print_scalar_formatted (valaddr, type, format, 0, stream); 493 else 494 print_floating (valaddr, type, stream); 495 break; 496 497 case TYPE_CODE_VOID: 498 fprintf_filtered (stream, "VOID"); 499 break; 500 501 case TYPE_CODE_ERROR: 502 fprintf_filtered (stream, "<error type>"); 503 break; 504 505 case TYPE_CODE_RANGE: 506 /* FIXME, we should not ever have to print one of these yet. */ 507 fprintf_filtered (stream, "<range type>"); 508 break; 509 510 case TYPE_CODE_BOOL: 511 format = format ? format : output_format; 512 if (format) 513 print_scalar_formatted (valaddr, type, format, 0, stream); 514 else 515 { 516 val = 0; 517 switch (TYPE_LENGTH (type)) 518 { 519 case 1: 520 val = unpack_long (builtin_type_f_logical_s1, valaddr); 521 break; 522 523 case 2: 524 val = unpack_long (builtin_type_f_logical_s2, valaddr); 525 break; 526 527 case 4: 528 val = unpack_long (builtin_type_f_logical, valaddr); 529 break; 530 531 default: 532 error ("Logicals of length %d bytes not supported", 533 TYPE_LENGTH (type)); 534 535 } 536 537 if (val == 0) 538 fprintf_filtered (stream, ".FALSE."); 539 else if (val == 1) 540 fprintf_filtered (stream, ".TRUE."); 541 else 542 /* Not a legitimate logical type, print as an integer. */ 543 { 544 /* Bash the type code temporarily. */ 545 TYPE_CODE (type) = TYPE_CODE_INT; 546 f_val_print (type, valaddr, 0, address, stream, format, 547 deref_ref, recurse, pretty); 548 /* Restore the type code so later uses work as intended. */ 549 TYPE_CODE (type) = TYPE_CODE_BOOL; 550 } 551 } 552 break; 553 554 case TYPE_CODE_COMPLEX: 555 switch (TYPE_LENGTH (type)) 556 { 557 case 8: 558 type = builtin_type_f_real; 559 break; 560 case 16: 561 type = builtin_type_f_real_s8; 562 break; 563 case 32: 564 type = builtin_type_f_real_s16; 565 break; 566 default: 567 error ("Cannot print out complex*%d variables", TYPE_LENGTH (type)); 568 } 569 fputs_filtered ("(", stream); 570 print_floating (valaddr, type, stream); 571 fputs_filtered (",", stream); 572 print_floating (valaddr + TYPE_LENGTH (type), type, stream); 573 fputs_filtered (")", stream); 574 break; 575 576 case TYPE_CODE_UNDEF: 577 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use 578 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar" 579 and no complete type for struct foo in that file. */ 580 fprintf_filtered (stream, "<incomplete type>"); 581 break; 582 583 default: 584 error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type)); 585 } 586 gdb_flush (stream); 587 return 0; 588} 589 590static void 591list_all_visible_commons (char *funname) 592{ 593 SAVED_F77_COMMON_PTR tmp; 594 595 tmp = head_common_list; 596 597 printf_filtered ("All COMMON blocks visible at this level:\n\n"); 598 599 while (tmp != NULL) 600 { 601 if (strcmp (tmp->owning_function, funname) == 0) 602 printf_filtered ("%s\n", tmp->name); 603 604 tmp = tmp->next; 605 } 606} 607 608/* This function is used to print out the values in a given COMMON 609 block. It will always use the most local common block of the 610 given name */ 611 612static void 613info_common_command (char *comname, int from_tty) 614{ 615 SAVED_F77_COMMON_PTR the_common; 616 COMMON_ENTRY_PTR entry; 617 struct frame_info *fi; 618 char *funname = 0; 619 struct symbol *func; 620 621 /* We have been told to display the contents of F77 COMMON 622 block supposedly visible in this function. Let us 623 first make sure that it is visible and if so, let 624 us display its contents */ 625 626 fi = deprecated_selected_frame; 627 628 if (fi == NULL) 629 error ("No frame selected"); 630 631 /* The following is generally ripped off from stack.c's routine 632 print_frame_info() */ 633 634 func = find_pc_function (get_frame_pc (fi)); 635 if (func) 636 { 637 /* In certain pathological cases, the symtabs give the wrong 638 function (when we are in the first function in a file which 639 is compiled without debugging symbols, the previous function 640 is compiled with debugging symbols, and the "foo.o" symbol 641 that is supposed to tell us where the file with debugging symbols 642 ends has been truncated by ar because it is longer than 15 643 characters). 644 645 So look in the minimal symbol tables as well, and if it comes 646 up with a larger address for the function use that instead. 647 I don't think this can ever cause any problems; there shouldn't 648 be any minimal symbols in the middle of a function. 649 FIXME: (Not necessarily true. What about text labels) */ 650 651 struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (get_frame_pc (fi)); 652 653 if (msymbol != NULL 654 && (SYMBOL_VALUE_ADDRESS (msymbol) 655 > BLOCK_START (SYMBOL_BLOCK_VALUE (func)))) 656 funname = DEPRECATED_SYMBOL_NAME (msymbol); 657 else 658 funname = DEPRECATED_SYMBOL_NAME (func); 659 } 660 else 661 { 662 struct minimal_symbol *msymbol = 663 lookup_minimal_symbol_by_pc (get_frame_pc (fi)); 664 665 if (msymbol != NULL) 666 funname = DEPRECATED_SYMBOL_NAME (msymbol); 667 } 668 669 /* If comname is NULL, we assume the user wishes to see the 670 which COMMON blocks are visible here and then return */ 671 672 if (comname == 0) 673 { 674 list_all_visible_commons (funname); 675 return; 676 } 677 678 the_common = find_common_for_function (comname, funname); 679 680 if (the_common) 681 { 682 if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0) 683 printf_filtered ("Contents of blank COMMON block:\n"); 684 else 685 printf_filtered ("Contents of F77 COMMON block '%s':\n", comname); 686 687 printf_filtered ("\n"); 688 entry = the_common->entries; 689 690 while (entry != NULL) 691 { 692 printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol)); 693 print_variable_value (entry->symbol, fi, gdb_stdout); 694 printf_filtered ("\n"); 695 entry = entry->next; 696 } 697 } 698 else 699 printf_filtered ("Cannot locate the common block %s in function '%s'\n", 700 comname, funname); 701} 702 703/* This function is used to determine whether there is a 704 F77 common block visible at the current scope called 'comname'. */ 705 706#if 0 707static int 708there_is_a_visible_common_named (char *comname) 709{ 710 SAVED_F77_COMMON_PTR the_common; 711 struct frame_info *fi; 712 char *funname = 0; 713 struct symbol *func; 714 715 if (comname == NULL) 716 error ("Cannot deal with NULL common name!"); 717 718 fi = deprecated_selected_frame; 719 720 if (fi == NULL) 721 error ("No frame selected"); 722 723 /* The following is generally ripped off from stack.c's routine 724 print_frame_info() */ 725 726 func = find_pc_function (fi->pc); 727 if (func) 728 { 729 /* In certain pathological cases, the symtabs give the wrong 730 function (when we are in the first function in a file which 731 is compiled without debugging symbols, the previous function 732 is compiled with debugging symbols, and the "foo.o" symbol 733 that is supposed to tell us where the file with debugging symbols 734 ends has been truncated by ar because it is longer than 15 735 characters). 736 737 So look in the minimal symbol tables as well, and if it comes 738 up with a larger address for the function use that instead. 739 I don't think this can ever cause any problems; there shouldn't 740 be any minimal symbols in the middle of a function. 741 FIXME: (Not necessarily true. What about text labels) */ 742 743 struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc); 744 745 if (msymbol != NULL 746 && (SYMBOL_VALUE_ADDRESS (msymbol) 747 > BLOCK_START (SYMBOL_BLOCK_VALUE (func)))) 748 funname = DEPRECATED_SYMBOL_NAME (msymbol); 749 else 750 funname = DEPRECATED_SYMBOL_NAME (func); 751 } 752 else 753 { 754 struct minimal_symbol *msymbol = 755 lookup_minimal_symbol_by_pc (fi->pc); 756 757 if (msymbol != NULL) 758 funname = DEPRECATED_SYMBOL_NAME (msymbol); 759 } 760 761 the_common = find_common_for_function (comname, funname); 762 763 return (the_common ? 1 : 0); 764} 765#endif 766 767void 768_initialize_f_valprint (void) 769{ 770 add_info ("common", info_common_command, 771 "Print out the values contained in a Fortran COMMON block."); 772 if (xdb_commands) 773 add_com ("lc", class_info, info_common_command, 774 "Print out the values contained in a Fortran COMMON block."); 775} 776