OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [f-valprint.c] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.