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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gdb-7.2/] [gdb/] [f-lang.c] - Blame information for rev 841

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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