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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [f-lang.c] - Blame information for rev 280

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

Line No. Rev Author Line
1 24 jeremybenn
/* Fortran language support routines for GDB, the GNU debugger.
2
 
3
   Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
4
   2004, 2005, 2007, 2008 Free Software Foundation, Inc.
5
 
6
   Contributed by Motorola.  Adapted from the C parser by Farooq Butt
7
   (fmbutt@engage.sps.mot.com).
8
 
9
   This file is part of GDB.
10
 
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.
15
 
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.
20
 
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/>.  */
23
 
24
#include "defs.h"
25
#include "gdb_string.h"
26
#include "symtab.h"
27
#include "gdbtypes.h"
28
#include "expression.h"
29
#include "parser-defs.h"
30
#include "language.h"
31
#include "f-lang.h"
32
#include "valprint.h"
33
#include "value.h"
34
 
35
 
36
/* Following is dubious stuff that had been in the xcoff reader. */
37
 
38
struct saved_fcn
39
  {
40
    long line_offset;           /* Line offset for function */
41
    struct saved_fcn *next;
42
  };
43
 
44
 
45
struct saved_bf_symnum
46
  {
47
    long symnum_fcn;            /* Symnum of function (i.e. .function directive) */
48
    long symnum_bf;             /* Symnum of .bf for this function */
49
    struct saved_bf_symnum *next;
50
  };
51
 
52
typedef struct saved_fcn SAVED_FUNCTION, *SAVED_FUNCTION_PTR;
53
typedef struct saved_bf_symnum SAVED_BF, *SAVED_BF_PTR;
54
 
55
/* Local functions */
56
 
57
extern void _initialize_f_language (void);
58
#if 0
59
static void clear_function_list (void);
60
static long get_bf_for_fcn (long);
61
static void clear_bf_list (void);
62
static void patch_all_commons_by_name (char *, CORE_ADDR, int);
63
static SAVED_F77_COMMON_PTR find_first_common_named (char *);
64
static void add_common_entry (struct symbol *);
65
static void add_common_block (char *, CORE_ADDR, int, char *);
66
static SAVED_FUNCTION *allocate_saved_function_node (void);
67
static SAVED_BF_PTR allocate_saved_bf_node (void);
68
static COMMON_ENTRY_PTR allocate_common_entry_node (void);
69
static SAVED_F77_COMMON_PTR allocate_saved_f77_common_node (void);
70
static void patch_common_entries (SAVED_F77_COMMON_PTR, CORE_ADDR, int);
71
#endif
72
 
73
static void f_printchar (int c, struct ui_file * stream);
74
static void f_emit_char (int c, struct ui_file * stream, int quoter);
75
 
76
/* Print the character C on STREAM as part of the contents of a literal
77
   string whose delimiter is QUOTER.  Note that that format for printing
78
   characters and strings is language specific.
79
   FIXME:  This is a copy of the same function from c-exp.y.  It should
80
   be replaced with a true F77 version.  */
81
 
82
static void
83
f_emit_char (int c, struct ui_file *stream, int quoter)
84
{
85
  c &= 0xFF;                    /* Avoid sign bit follies */
86
 
87
  if (PRINT_LITERAL_FORM (c))
88
    {
89
      if (c == '\\' || c == quoter)
90
        fputs_filtered ("\\", stream);
91
      fprintf_filtered (stream, "%c", c);
92
    }
93
  else
94
    {
95
      switch (c)
96
        {
97
        case '\n':
98
          fputs_filtered ("\\n", stream);
99
          break;
100
        case '\b':
101
          fputs_filtered ("\\b", stream);
102
          break;
103
        case '\t':
104
          fputs_filtered ("\\t", stream);
105
          break;
106
        case '\f':
107
          fputs_filtered ("\\f", stream);
108
          break;
109
        case '\r':
110
          fputs_filtered ("\\r", stream);
111
          break;
112
        case '\033':
113
          fputs_filtered ("\\e", stream);
114
          break;
115
        case '\007':
116
          fputs_filtered ("\\a", stream);
117
          break;
118
        default:
119
          fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
120
          break;
121
        }
122
    }
123
}
124
 
125
/* FIXME:  This is a copy of the same function from c-exp.y.  It should
126
   be replaced with a true F77version. */
127
 
128
static void
129
f_printchar (int c, struct ui_file *stream)
130
{
131
  fputs_filtered ("'", stream);
132
  LA_EMIT_CHAR (c, stream, '\'');
133
  fputs_filtered ("'", stream);
134
}
135
 
136
/* Print the character string STRING, printing at most LENGTH characters.
137
   Printing stops early if the number hits print_max; repeat counts
138
   are printed as appropriate.  Print ellipses at the end if we
139
   had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
140
   FIXME:  This is a copy of the same function from c-exp.y.  It should
141
   be replaced with a true F77 version. */
142
 
143
static void
144
f_printstr (struct ui_file *stream, const gdb_byte *string,
145
            unsigned int length, int width, int force_ellipses)
146
{
147
  unsigned int i;
148
  unsigned int things_printed = 0;
149
  int in_quotes = 0;
150
  int need_comma = 0;
151
 
152
  if (length == 0)
153
    {
154
      fputs_filtered ("''", gdb_stdout);
155
      return;
156
    }
157
 
158
  for (i = 0; i < length && things_printed < print_max; ++i)
159
    {
160
      /* Position of the character we are examining
161
         to see whether it is repeated.  */
162
      unsigned int rep1;
163
      /* Number of repetitions we have detected so far.  */
164
      unsigned int reps;
165
 
166
      QUIT;
167
 
168
      if (need_comma)
169
        {
170
          fputs_filtered (", ", stream);
171
          need_comma = 0;
172
        }
173
 
174
      rep1 = i + 1;
175
      reps = 1;
176
      while (rep1 < length && string[rep1] == string[i])
177
        {
178
          ++rep1;
179
          ++reps;
180
        }
181
 
182
      if (reps > repeat_count_threshold)
183
        {
184
          if (in_quotes)
185
            {
186
              if (inspect_it)
187
                fputs_filtered ("\\', ", stream);
188
              else
189
                fputs_filtered ("', ", stream);
190
              in_quotes = 0;
191
            }
192
          f_printchar (string[i], stream);
193
          fprintf_filtered (stream, " <repeats %u times>", reps);
194
          i = rep1 - 1;
195
          things_printed += repeat_count_threshold;
196
          need_comma = 1;
197
        }
198
      else
199
        {
200
          if (!in_quotes)
201
            {
202
              if (inspect_it)
203
                fputs_filtered ("\\'", stream);
204
              else
205
                fputs_filtered ("'", stream);
206
              in_quotes = 1;
207
            }
208
          LA_EMIT_CHAR (string[i], stream, '"');
209
          ++things_printed;
210
        }
211
    }
212
 
213
  /* Terminate the quotes if necessary.  */
214
  if (in_quotes)
215
    {
216
      if (inspect_it)
217
        fputs_filtered ("\\'", stream);
218
      else
219
        fputs_filtered ("'", stream);
220
    }
221
 
222
  if (force_ellipses || i < length)
223
    fputs_filtered ("...", stream);
224
}
225
 
226
 
227
/* Table of operators and their precedences for printing expressions.  */
228
 
229
static const struct op_print f_op_print_tab[] =
230
{
231
  {"+", BINOP_ADD, PREC_ADD, 0},
232
  {"+", UNOP_PLUS, PREC_PREFIX, 0},
233
  {"-", BINOP_SUB, PREC_ADD, 0},
234
  {"-", UNOP_NEG, PREC_PREFIX, 0},
235
  {"*", BINOP_MUL, PREC_MUL, 0},
236
  {"/", BINOP_DIV, PREC_MUL, 0},
237
  {"DIV", BINOP_INTDIV, PREC_MUL, 0},
238
  {"MOD", BINOP_REM, PREC_MUL, 0},
239
  {"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
240
  {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
241
  {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
242
  {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
243
  {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
244
  {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
245
  {".LE.", BINOP_LEQ, PREC_ORDER, 0},
246
  {".GE.", BINOP_GEQ, PREC_ORDER, 0},
247
  {".GT.", BINOP_GTR, PREC_ORDER, 0},
248
  {".LT.", BINOP_LESS, PREC_ORDER, 0},
249
  {"**", UNOP_IND, PREC_PREFIX, 0},
250
  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
251
  {NULL, 0, 0, 0}
252
};
253
 
254
enum f_primitive_types {
255
  f_primitive_type_character,
256
  f_primitive_type_logical,
257
  f_primitive_type_logical_s1,
258
  f_primitive_type_logical_s2,
259
  f_primitive_type_integer,
260
  f_primitive_type_integer_s2,
261
  f_primitive_type_real,
262
  f_primitive_type_real_s8,
263
  f_primitive_type_real_s16,
264
  f_primitive_type_complex_s8,
265
  f_primitive_type_complex_s16,
266
  f_primitive_type_void,
267
  nr_f_primitive_types
268
};
269
 
270
static void
271
f_language_arch_info (struct gdbarch *gdbarch,
272
                      struct language_arch_info *lai)
273
{
274
  const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
275
 
276
  lai->string_char_type = builtin->builtin_character;
277
  lai->primitive_type_vector
278
    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
279
                              struct type *);
280
 
281
  lai->primitive_type_vector [f_primitive_type_character]
282
    = builtin->builtin_character;
283
  lai->primitive_type_vector [f_primitive_type_logical]
284
    = builtin->builtin_logical;
285
  lai->primitive_type_vector [f_primitive_type_logical_s1]
286
    = builtin->builtin_logical_s1;
287
  lai->primitive_type_vector [f_primitive_type_logical_s2]
288
    = builtin->builtin_logical_s2;
289
  lai->primitive_type_vector [f_primitive_type_real]
290
    = builtin->builtin_real;
291
  lai->primitive_type_vector [f_primitive_type_real_s8]
292
    = builtin->builtin_real_s8;
293
  lai->primitive_type_vector [f_primitive_type_real_s16]
294
    = builtin->builtin_real_s16;
295
  lai->primitive_type_vector [f_primitive_type_complex_s8]
296
    = builtin->builtin_complex_s8;
297
  lai->primitive_type_vector [f_primitive_type_complex_s16]
298
    = builtin->builtin_complex_s16;
299
  lai->primitive_type_vector [f_primitive_type_void]
300
    = builtin->builtin_void;
301
}
302
 
303
/* This is declared in c-lang.h but it is silly to import that file for what
304
   is already just a hack. */
305
extern int c_value_print (struct value *, struct ui_file *, int,
306
                          enum val_prettyprint);
307
 
308
const struct language_defn f_language_defn =
309
{
310
  "fortran",
311
  language_fortran,
312
  range_check_on,
313
  type_check_on,
314
  case_sensitive_off,
315
  array_column_major,
316
  &exp_descriptor_standard,
317
  f_parse,                      /* parser */
318
  f_error,                      /* parser error function */
319
  null_post_parser,
320
  f_printchar,                  /* Print character constant */
321
  f_printstr,                   /* function to print string constant */
322
  f_emit_char,                  /* Function to print a single character */
323
  f_print_type,                 /* Print a type using appropriate syntax */
324
  f_val_print,                  /* Print a value using appropriate syntax */
325
  c_value_print,                /* FIXME */
326
  NULL,                         /* Language specific skip_trampoline */
327
  value_of_this,                /* value_of_this */
328
  basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
329
  basic_lookup_transparent_type,/* lookup_transparent_type */
330
  NULL,                         /* Language specific symbol demangler */
331
  NULL,                         /* Language specific class_name_from_physname */
332
  f_op_print_tab,               /* expression operators for printing */
333
  0,                             /* arrays are first-class (not c-style) */
334
  1,                            /* String lower bound */
335
  default_word_break_characters,
336
  default_make_symbol_completion_list,
337
  f_language_arch_info,
338
  default_print_array_index,
339
  default_pass_by_reference,
340
  LANG_MAGIC
341
};
342
 
343
static void *
344
build_fortran_types (struct gdbarch *gdbarch)
345
{
346
  struct builtin_f_type *builtin_f_type
347
    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
348
 
349
  builtin_f_type->builtin_void =
350
    init_type (TYPE_CODE_VOID, 1,
351
               0,
352
               "VOID", (struct objfile *) NULL);
353
 
354
  builtin_f_type->builtin_character =
355
    init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
356
               0,
357
               "character", (struct objfile *) NULL);
358
 
359
  builtin_f_type->builtin_logical_s1 =
360
    init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
361
               TYPE_FLAG_UNSIGNED,
362
               "logical*1", (struct objfile *) NULL);
363
 
364
  builtin_f_type->builtin_integer_s2 =
365
    init_type (TYPE_CODE_INT,
366
               gdbarch_short_bit (gdbarch) / TARGET_CHAR_BIT,
367
               0, "integer*2", (struct objfile *) NULL);
368
 
369
  builtin_f_type->builtin_logical_s2 =
370
    init_type (TYPE_CODE_BOOL,
371
               gdbarch_short_bit (gdbarch) / TARGET_CHAR_BIT,
372
               TYPE_FLAG_UNSIGNED, "logical*2", (struct objfile *) NULL);
373
 
374
  builtin_f_type->builtin_integer =
375
    init_type (TYPE_CODE_INT,
376
               gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
377
               0, "integer", (struct objfile *) NULL);
378
 
379
  builtin_f_type->builtin_logical =
380
    init_type (TYPE_CODE_BOOL,
381
               gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
382
               TYPE_FLAG_UNSIGNED, "logical*4", (struct objfile *) NULL);
383
 
384
  builtin_f_type->builtin_real =
385
    init_type (TYPE_CODE_FLT,
386
               gdbarch_float_bit (gdbarch) / TARGET_CHAR_BIT,
387
               0,
388
               "real", (struct objfile *) NULL);
389
 
390
  builtin_f_type->builtin_real_s8 =
391
    init_type (TYPE_CODE_FLT,
392
               gdbarch_double_bit (gdbarch) / TARGET_CHAR_BIT,
393
               0,
394
               "real*8", (struct objfile *) NULL);
395
 
396
  builtin_f_type->builtin_real_s16 =
397
    init_type (TYPE_CODE_FLT,
398
               gdbarch_long_double_bit (gdbarch) / TARGET_CHAR_BIT,
399
               0,
400
               "real*16", (struct objfile *) NULL);
401
 
402
  builtin_f_type->builtin_complex_s8 =
403
    init_type (TYPE_CODE_COMPLEX,
404
               2 * gdbarch_float_bit (gdbarch) / TARGET_CHAR_BIT,
405
               0,
406
               "complex*8", (struct objfile *) NULL);
407
  TYPE_TARGET_TYPE (builtin_f_type->builtin_complex_s8)
408
    = builtin_f_type->builtin_real;
409
 
410
  builtin_f_type->builtin_complex_s16 =
411
    init_type (TYPE_CODE_COMPLEX,
412
               2 * gdbarch_double_bit (gdbarch) / TARGET_CHAR_BIT,
413
               0,
414
               "complex*16", (struct objfile *) NULL);
415
  TYPE_TARGET_TYPE (builtin_f_type->builtin_complex_s16)
416
    = builtin_f_type->builtin_real_s8;
417
 
418
  /* We have a new size == 4 double floats for the
419
     complex*32 data type */
420
 
421
  builtin_f_type->builtin_complex_s32 =
422
    init_type (TYPE_CODE_COMPLEX,
423
               2 * gdbarch_long_double_bit (gdbarch) / TARGET_CHAR_BIT,
424
               0,
425
               "complex*32", (struct objfile *) NULL);
426
  TYPE_TARGET_TYPE (builtin_f_type->builtin_complex_s32)
427
    = builtin_f_type->builtin_real_s16;
428
 
429
  return builtin_f_type;
430
}
431
 
432
static struct gdbarch_data *f_type_data;
433
 
434
const struct builtin_f_type *
435
builtin_f_type (struct gdbarch *gdbarch)
436
{
437
  return gdbarch_data (gdbarch, f_type_data);
438
}
439
 
440
void
441
_initialize_f_language (void)
442
{
443
  f_type_data = gdbarch_data_register_post_init (build_fortran_types);
444
 
445
  add_language (&f_language_defn);
446
}
447
 
448
#if 0
449
static SAVED_BF_PTR
450
allocate_saved_bf_node (void)
451
{
452
  SAVED_BF_PTR new;
453
 
454
  new = (SAVED_BF_PTR) xmalloc (sizeof (SAVED_BF));
455
  return (new);
456
}
457
 
458
static SAVED_FUNCTION *
459
allocate_saved_function_node (void)
460
{
461
  SAVED_FUNCTION *new;
462
 
463
  new = (SAVED_FUNCTION *) xmalloc (sizeof (SAVED_FUNCTION));
464
  return (new);
465
}
466
 
467
static SAVED_F77_COMMON_PTR
468
allocate_saved_f77_common_node (void)
469
{
470
  SAVED_F77_COMMON_PTR new;
471
 
472
  new = (SAVED_F77_COMMON_PTR) xmalloc (sizeof (SAVED_F77_COMMON));
473
  return (new);
474
}
475
 
476
static COMMON_ENTRY_PTR
477
allocate_common_entry_node (void)
478
{
479
  COMMON_ENTRY_PTR new;
480
 
481
  new = (COMMON_ENTRY_PTR) xmalloc (sizeof (COMMON_ENTRY));
482
  return (new);
483
}
484
#endif
485
 
486
SAVED_F77_COMMON_PTR head_common_list = NULL;   /* Ptr to 1st saved COMMON  */
487
SAVED_F77_COMMON_PTR tail_common_list = NULL;   /* Ptr to last saved COMMON  */
488
SAVED_F77_COMMON_PTR current_common = NULL;     /* Ptr to current COMMON */
489
 
490
#if 0
491
static SAVED_BF_PTR saved_bf_list = NULL;       /* Ptr to (.bf,function)
492
                                                   list */
493
static SAVED_BF_PTR saved_bf_list_end = NULL;   /* Ptr to above list's end */
494
static SAVED_BF_PTR current_head_bf_list = NULL;        /* Current head of above list
495
                                                         */
496
 
497
static SAVED_BF_PTR tmp_bf_ptr; /* Generic temporary for use
498
                                   in macros */
499
 
500
/* The following function simply enters a given common block onto
501
   the global common block chain */
502
 
503
static void
504
add_common_block (char *name, CORE_ADDR offset, int secnum, char *func_stab)
505
{
506
  SAVED_F77_COMMON_PTR tmp;
507
  char *c, *local_copy_func_stab;
508
 
509
  /* If the COMMON block we are trying to add has a blank
510
     name (i.e. "#BLNK_COM") then we set it to __BLANK
511
     because the darn "#" character makes GDB's input
512
     parser have fits. */
513
 
514
 
515
  if (strcmp (name, BLANK_COMMON_NAME_ORIGINAL) == 0
516
      || strcmp (name, BLANK_COMMON_NAME_MF77) == 0)
517
    {
518
 
519
      xfree (name);
520
      name = alloca (strlen (BLANK_COMMON_NAME_LOCAL) + 1);
521
      strcpy (name, BLANK_COMMON_NAME_LOCAL);
522
    }
523
 
524
  tmp = allocate_saved_f77_common_node ();
525
 
526
  local_copy_func_stab = xmalloc (strlen (func_stab) + 1);
527
  strcpy (local_copy_func_stab, func_stab);
528
 
529
  tmp->name = xmalloc (strlen (name) + 1);
530
 
531
  /* local_copy_func_stab is a stabstring, let us first extract the
532
     function name from the stab by NULLing out the ':' character. */
533
 
534
 
535
  c = NULL;
536
  c = strchr (local_copy_func_stab, ':');
537
 
538
  if (c)
539
    *c = '\0';
540
  else
541
    error (_("Malformed function STAB found in add_common_block()"));
542
 
543
 
544
  tmp->owning_function = xmalloc (strlen (local_copy_func_stab) + 1);
545
 
546
  strcpy (tmp->owning_function, local_copy_func_stab);
547
 
548
  strcpy (tmp->name, name);
549
  tmp->offset = offset;
550
  tmp->next = NULL;
551
  tmp->entries = NULL;
552
  tmp->secnum = secnum;
553
 
554
  current_common = tmp;
555
 
556
  if (head_common_list == NULL)
557
    {
558
      head_common_list = tail_common_list = tmp;
559
    }
560
  else
561
    {
562
      tail_common_list->next = tmp;
563
      tail_common_list = tmp;
564
    }
565
}
566
#endif
567
 
568
/* The following function simply enters a given common entry onto
569
   the "current_common" block that has been saved away. */
570
 
571
#if 0
572
static void
573
add_common_entry (struct symbol *entry_sym_ptr)
574
{
575
  COMMON_ENTRY_PTR tmp;
576
 
577
 
578
 
579
  /* The order of this list is important, since
580
     we expect the entries to appear in decl.
581
     order when we later issue "info common" calls */
582
 
583
  tmp = allocate_common_entry_node ();
584
 
585
  tmp->next = NULL;
586
  tmp->symbol = entry_sym_ptr;
587
 
588
  if (current_common == NULL)
589
    error (_("Attempt to add COMMON entry with no block open!"));
590
  else
591
    {
592
      if (current_common->entries == NULL)
593
        {
594
          current_common->entries = tmp;
595
          current_common->end_of_entries = tmp;
596
        }
597
      else
598
        {
599
          current_common->end_of_entries->next = tmp;
600
          current_common->end_of_entries = tmp;
601
        }
602
    }
603
}
604
#endif
605
 
606
/* This routine finds the first encountred COMMON block named "name" */
607
 
608
#if 0
609
static SAVED_F77_COMMON_PTR
610
find_first_common_named (char *name)
611
{
612
 
613
  SAVED_F77_COMMON_PTR tmp;
614
 
615
  tmp = head_common_list;
616
 
617
  while (tmp != NULL)
618
    {
619
      if (strcmp (tmp->name, name) == 0)
620
        return (tmp);
621
      else
622
        tmp = tmp->next;
623
    }
624
  return (NULL);
625
}
626
#endif
627
 
628
/* This routine finds the first encountred COMMON block named "name"
629
   that belongs to function funcname */
630
 
631
SAVED_F77_COMMON_PTR
632
find_common_for_function (char *name, char *funcname)
633
{
634
 
635
  SAVED_F77_COMMON_PTR tmp;
636
 
637
  tmp = head_common_list;
638
 
639
  while (tmp != NULL)
640
    {
641
      if (strcmp (tmp->name, name) == 0
642
          && strcmp (tmp->owning_function, funcname) == 0)
643
        return (tmp);
644
      else
645
        tmp = tmp->next;
646
    }
647
  return (NULL);
648
}
649
 
650
 
651
#if 0
652
 
653
/* The following function is called to patch up the offsets
654
   for the statics contained in the COMMON block named
655
   "name."  */
656
 
657
static void
658
patch_common_entries (SAVED_F77_COMMON_PTR blk, CORE_ADDR offset, int secnum)
659
{
660
  COMMON_ENTRY_PTR entry;
661
 
662
  blk->offset = offset;         /* Keep this around for future use. */
663
 
664
  entry = blk->entries;
665
 
666
  while (entry != NULL)
667
    {
668
      SYMBOL_VALUE (entry->symbol) += offset;
669
      SYMBOL_SECTION (entry->symbol) = secnum;
670
 
671
      entry = entry->next;
672
    }
673
  blk->secnum = secnum;
674
}
675
 
676
/* Patch all commons named "name" that need patching.Since COMMON
677
   blocks occur with relative infrequency, we simply do a linear scan on
678
   the name.  Eventually, the best way to do this will be a
679
   hashed-lookup.  Secnum is the section number for the .bss section
680
   (which is where common data lives). */
681
 
682
static void
683
patch_all_commons_by_name (char *name, CORE_ADDR offset, int secnum)
684
{
685
 
686
  SAVED_F77_COMMON_PTR tmp;
687
 
688
  /* For blank common blocks, change the canonical reprsentation
689
     of a blank name */
690
 
691
  if (strcmp (name, BLANK_COMMON_NAME_ORIGINAL) == 0
692
      || strcmp (name, BLANK_COMMON_NAME_MF77) == 0)
693
    {
694
      xfree (name);
695
      name = alloca (strlen (BLANK_COMMON_NAME_LOCAL) + 1);
696
      strcpy (name, BLANK_COMMON_NAME_LOCAL);
697
    }
698
 
699
  tmp = head_common_list;
700
 
701
  while (tmp != NULL)
702
    {
703
      if (COMMON_NEEDS_PATCHING (tmp))
704
        if (strcmp (tmp->name, name) == 0)
705
          patch_common_entries (tmp, offset, secnum);
706
 
707
      tmp = tmp->next;
708
    }
709
}
710
#endif
711
 
712
/* This macro adds the symbol-number for the start of the function
713
   (the symbol number of the .bf) referenced by symnum_fcn to a
714
   list.  This list, in reality should be a FIFO queue but since
715
   #line pragmas sometimes cause line ranges to get messed up
716
   we simply create a linear list.  This list can then be searched
717
   first by a queueing algorithm and upon failure fall back to
718
   a linear scan. */
719
 
720
#if 0
721
#define ADD_BF_SYMNUM(bf_sym,fcn_sym) \
722
  \
723
  if (saved_bf_list == NULL) \
724
{ \
725
    tmp_bf_ptr = allocate_saved_bf_node(); \
726
      \
727
        tmp_bf_ptr->symnum_bf = (bf_sym); \
728
          tmp_bf_ptr->symnum_fcn = (fcn_sym);  \
729
            tmp_bf_ptr->next = NULL; \
730
              \
731
                current_head_bf_list = saved_bf_list = tmp_bf_ptr; \
732
                  saved_bf_list_end = tmp_bf_ptr; \
733
                  } \
734
else \
735
{  \
736
     tmp_bf_ptr = allocate_saved_bf_node(); \
737
       \
738
         tmp_bf_ptr->symnum_bf = (bf_sym);  \
739
           tmp_bf_ptr->symnum_fcn = (fcn_sym);  \
740
             tmp_bf_ptr->next = NULL;  \
741
               \
742
                 saved_bf_list_end->next = tmp_bf_ptr;  \
743
                   saved_bf_list_end = tmp_bf_ptr; \
744
                   }
745
#endif
746
 
747
/* This function frees the entire (.bf,function) list */
748
 
749
#if 0
750
static void
751
clear_bf_list (void)
752
{
753
 
754
  SAVED_BF_PTR tmp = saved_bf_list;
755
  SAVED_BF_PTR next = NULL;
756
 
757
  while (tmp != NULL)
758
    {
759
      next = tmp->next;
760
      xfree (tmp);
761
      tmp = next;
762
    }
763
  saved_bf_list = NULL;
764
}
765
#endif
766
 
767
int global_remote_debug;
768
 
769
#if 0
770
 
771
static long
772
get_bf_for_fcn (long the_function)
773
{
774
  SAVED_BF_PTR tmp;
775
  int nprobes = 0;
776
 
777
  /* First use a simple queuing algorithm (i.e. look and see if the
778
     item at the head of the queue is the one you want)  */
779
 
780
  if (saved_bf_list == NULL)
781
    internal_error (__FILE__, __LINE__,
782
                    _("cannot get .bf node off empty list"));
783
 
784
  if (current_head_bf_list != NULL)
785
    if (current_head_bf_list->symnum_fcn == the_function)
786
      {
787
        if (global_remote_debug)
788
          fprintf_unfiltered (gdb_stderr, "*");
789
 
790
        tmp = current_head_bf_list;
791
        current_head_bf_list = current_head_bf_list->next;
792
        return (tmp->symnum_bf);
793
      }
794
 
795
  /* If the above did not work (probably because #line directives were
796
     used in the sourcefile and they messed up our internal tables) we now do
797
     the ugly linear scan */
798
 
799
  if (global_remote_debug)
800
    fprintf_unfiltered (gdb_stderr, "\ndefaulting to linear scan\n");
801
 
802
  nprobes = 0;
803
  tmp = saved_bf_list;
804
  while (tmp != NULL)
805
    {
806
      nprobes++;
807
      if (tmp->symnum_fcn == the_function)
808
        {
809
          if (global_remote_debug)
810
            fprintf_unfiltered (gdb_stderr, "Found in %d probes\n", nprobes);
811
          current_head_bf_list = tmp->next;
812
          return (tmp->symnum_bf);
813
        }
814
      tmp = tmp->next;
815
    }
816
 
817
  return (-1);
818
}
819
 
820
static SAVED_FUNCTION_PTR saved_function_list = NULL;
821
static SAVED_FUNCTION_PTR saved_function_list_end = NULL;
822
 
823
static void
824
clear_function_list (void)
825
{
826
  SAVED_FUNCTION_PTR tmp = saved_function_list;
827
  SAVED_FUNCTION_PTR next = NULL;
828
 
829
  while (tmp != NULL)
830
    {
831
      next = tmp->next;
832
      xfree (tmp);
833
      tmp = next;
834
    }
835
 
836
  saved_function_list = NULL;
837
}
838
#endif

powered by: WebSVN 2.1.0

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